vba help - record total matched

[mak]

Hi
don't know if that is possible (probably is) but haven't manage to make it

I need a macro which will record only the when the cell change and not on every refresh

so for example
if cell p5 change cell ba5=p5
if p5 change again cell ba5=p5 last | cell bb5=p5 prelast
ideally I need the last 4 changes only

any ideas please?

[alrodopial]

Inside your code that updates at every refresh something like this:

Code: Select all

Dim previusVALUE As Double
.......
If Range("P5") <> previusVALUE Then
... copy odds
previusVALUE = Range("P5") .Value
Range("BB5:BD5") = Range("BA5:BC5")
Range("BA5") = Range("P5").Value
End If

..... your code here


previusVALUE must be declared outside of macro

[mak]

Al hi

i tried it but it record only the first change in BA5 cell only

i tried to make a few changes but nothing happened..

I have this code which Osknows provided some long time ago which records the prices exactly as I need but for every refresh and not when there is a cell change..

I also tried to combine it with yours but no joy...
Do you believe you can adjust it?

it needs an if statement something like
if range ("o5:o55")..change then... but can't work it out
to be honest i can't easily understand how this code is working anyway
i am not good at vba and especially with arrays...

----------------------------------------------------------------------------

Option Explicit


Dim rng As Range
Dim slicestrArray2, i As Long
Dim strArraymac(), slicestrArray, holdingarray() As Variant


Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Columns.Count = 16 Then

'change Sheets(1) to whatever sheet you need


Application.EnableEvents = False

Set rng = Range("a5:cz55")
strArraymac = rng

For i = 1 To UBound(strArraymac)

strArraymac(i, 100) = strArraymac(i, 15) '15 is col O, 100 is unused array address
strArraymac(i, 101) = strArraymac(i, 53) '53 is col BA, 101 is unused array address
strArraymac(i, 102) = strArraymac(i, 54) '54 is col BB, 102 is unused array address
strArraymac(i, 103) = strArraymac(i, 55) '55 is col BC, 103 is unused array address
strArraymac(i, 104) = strArraymac(i, 56) '56 is col BD, 104 is unused array address

Next i

slicestrArray = ThisWorkbook.Sheets(1).Range("ba5:be55")
slicestrArray2 = UBound(slicestrArray)

ReDim holdingarray(1 To slicestrArray2, 4)

For i = 1 To UBound(strArraymac)
holdingarray(i, 0) = strArraymac(i, 100)
holdingarray(i, 1) = strArraymac(i, 101)
holdingarray(i, 2) = strArraymac(i, 102)
holdingarray(i, 3) = strArraymac(i, 103)
holdingarray(i, 4) = strArraymac(i, 104)
Next i

ThisWorkbook.Sheets("Market").Range("ba5:be55").Value = holdingarray

Application.EnableEvents = True
End If

End Sub

[alrodopial]

Try the below

Code: Select all

Dim TotalAmountMatchedArray() As Variant
Dim TotalAmountMatchedPREVIUSArray() As Variant

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Columns.Count = 16 Then
        Application.EnableEvents = False

        Lrow = Range("A55").End(xlUp).Row ' last row with data
        NumberOfSelections = Lrow - 4

        Set rng = Range("A5:CZ" & Lrow)
        DataArray = rng

        ReDim TotalAmountMatchedArray(NumberOfSelections, 1)
        ReDim TotalAmountMatchedPREVIUSArray(NumberOfSelections, 1)
        ReDim TempArray(1 To NumberOfSelections, 8)
   
        Set rng = ThisWorkbook.Sheets("Market").Range("BA5:BH" & Lrow)
        TempArray = rng
        Set rng = Range("AE5:AE" & Lrow)
        TotalAmountMatchedPREVIUSArray = rng
        Set rng = Range("O5:O" & Lrow)
        TotalAmountMatchedArray = rng
   
        For i = 1 To NumberOfSelections
       
            If TotalAmountMatchedArray(i, 1) <> TotalAmountMatchedPREVIUSArray(i, 1) Then
                TempArray(i, 4) = TempArray(i, 3)
                TempArray(i, 3) = TempArray(i, 2)
                TempArray(i, 2) = TempArray(i, 1)
                TempArray(i, 1) = TotalAmountMatchedPREVIUSArray(i, 1)
                TempArray(i, 5) = DataArray(i, 53)
                TempArray(i, 6) = DataArray(i, 54)
                TempArray(i, 7) = DataArray(i, 55)
                TempArray(i, 8) = DataArray(i, 56)
            Else
                TempArray(i, 5) = DataArray(i, 53)
                TempArray(i, 6) = DataArray(i, 54)
                TempArray(i, 7) = DataArray(i, 55)
                TempArray(i, 8) = DataArray(i, 56)
            End If
        Next i

        ThisWorkbook.Sheets("Market").Range("BA5:BH" & Lrow).Value = TempArray
        Range("AE5:AE" & Lrow) = rng.Value ' Copy the values for use in the next refresh in which they will be 'the old values'

        Application.EnableEvents = True
    End If

End Sub

I couldn't keep the 'TotalAmountMatchedPREVIUSArray' stay in the memory for use in the next refresh so I had to copy it at cells AE5:AE... in the current sheet and get it at every new refresh.
Any ideas why this is happening?
Same with 'TempArray'

Arrays are 'difficult' to me also

[alrodopial]

thete are some more variants at the top that left outside from the copy-paste

Code: Select all


Dim rng As Range
Dim Lrow, NumberOfSelections, i As Integer
Dim DataArray(), TempArray() As Variant
Dim TotalAmountMatchedArray() As Variant
Dim TotalAmountMatchedPREVIUSArray() As Variant

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Columns.Count = 16 Then
        Application.EnableEvents = False

        Lrow = Range("A55").End(xlUp).Row ' last row with data
        NumberOfSelections = Lrow - 4

        Set rng = Range("A5:CZ" & Lrow)
        DataArray = rng

        ReDim TotalAmountMatchedArray(NumberOfSelections, 1)
        ReDim TotalAmountMatchedPREVIUSArray(NumberOfSelections, 1)
        ReDim TempArray(1 To NumberOfSelections, 8)
   
        Set rng = ThisWorkbook.Sheets("Market").Range("BA5:BH" & Lrow)
        TempArray = rng
        Set rng = Range("AE5:AE" & Lrow)
        TotalAmountMatchedPREVIUSArray = rng
        Set rng = Range("O5:O" & Lrow)
        TotalAmountMatchedArray = rng
   
        For i = 1 To NumberOfSelections
       
            If TotalAmountMatchedArray(i, 1) <> TotalAmountMatchedPREVIUSArray(i, 1) Then
                TempArray(i, 4) = TempArray(i, 3)
                TempArray(i, 3) = TempArray(i, 2)
                TempArray(i, 2) = TempArray(i, 1)
                TempArray(i, 1) = TotalAmountMatchedPREVIUSArray(i, 1)
                TempArray(i, 5) = DataArray(i, 53)
                TempArray(i, 6) = DataArray(i, 54)
                TempArray(i, 7) = DataArray(i, 55)
                TempArray(i, 8) = DataArray(i, 56)
            Else
                TempArray(i, 5) = DataArray(i, 53)
                TempArray(i, 6) = DataArray(i, 54)
                TempArray(i, 7) = DataArray(i, 55)
                TempArray(i, 8) = DataArray(i, 56)
            End If
        Next i

        ThisWorkbook.Sheets("Market").Range("BA5:BH" & Lrow).Value = TempArray
        Range("AE5:AE" & Lrow) = rng.Value ' Copy the values for use in the next refresh in which they will be 'the old values'

        Application.EnableEvents = True
    End If

End Sub

[mak]

Al hi & thanks for your time and effort!

I will have to wait in order to have some active markets to watch live but here a few things I noticed

a. it writes twice the values
it uses cells ba5-bd5 correct, but it writes the same values in be5-bh5 cells. ba5=be5 etc.. I tried to adjust the code ("BA5:BH" & Lrow) to bd" but got a message "out of range".. so I hide the extra columns

b. here probably i will need some extra help if and when is possible
when i move to the next market the recorded cells remains as previous market numbers until some bets to get matched & if the previous market had 8 runners and the new one 3 it still remains with 8 runners updating only the 3...

c. That is rhetorical probably but which cells should I adapt if I would need for example the last 8 prices?


Thanks a lot again Al

[alrodopial]

In theory in cells be5-bh5 (sheet market) will be copied data from cell BA5-BD5 (first sheet)

Do you have data in these cells ?
I assume you have formulas in them

[mak]

I am a little confused
I am using only 1 sheet - sheet Market

My formulas will be after ca column-No problem

I don't understand
"will be copied data from cell BA5-BD5 (first sheet) "

[alrodopial]

To clear things:

Do you want ONLY the previous odds to be copied ( 4 or 8 previous as described above) or do you have also other data in your sheet that need to be copied?

[mak]

i need only the previous odds

[alrodopial]

Try the below:
It records from the time that a second change has been made at the odds

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Columns.Count = 16 Then
        Application.EnableEvents = False

        Lrow = ThisWorkbook.Sheets("Market").Range("A55").End(xlUp).Row ' last row with data
        NumberOfSelections = Lrow - 4

        ReDim TotalAmountMatchedArray(NumberOfSelections, 1)
        ReDim TotalAmountMatchedPREVIOUSArray(NumberOfSelections, 1)
        ReDim TempArray(NumberOfSelections, 8)
   
        Set rng = ThisWorkbook.Sheets("Market").Range("BA5:BH" & Lrow)
        TempArray = rng
        Set rng = ThisWorkbook.Sheets("Market").Range("AE5:AE" & Lrow)
        TotalAmountMatchedPREVIOUSArray = rng
        Set rng = ThisWorkbook.Sheets("Market").Range("O5:O" & Lrow)
        TotalAmountMatchedArray = rng
   
        For i = 1 To NumberOfSelections
            If TotalAmountMatchedArray(i, 1) <> TotalAmountMatchedPREVIOUSArray(i, 1) Then
                TempArray(i, 8) = TempArray(i, 7)
                TempArray(i, 7) = TempArray(i, 6)
                TempArray(i, 6) = TempArray(i, 5)
                TempArray(i, 5) = TempArray(i, 4)
                TempArray(i, 4) = TempArray(i, 3)
                TempArray(i, 3) = TempArray(i, 2)
                TempArray(i, 2) = TempArray(i, 1)
                TempArray(i, 1) = TotalAmountMatchedPREVIOUSArray(i, 1)
            End If
        Next i

        ThisWorkbook.Sheets("Market").Range("BA5:BH" & Lrow).Value = TempArray
        ThisWorkbook.Sheets("Market").Range("AE5:AE" & Lrow) = rng.Value ' Copy the values for use in the next refresh in which they will be 'the old values'

        Application.EnableEvents = True
    End If

End Sub

[alrodopial]

I added to clear the cells when the market changes

Code: Select all


Dim currentRACE As String
Dim rng As Range
Dim Lrow, NumberOfSelections, i As Integer
Dim TempArray() As Variant
Dim TotalAmountMatchedArray() As Variant
Dim TotalAmountMatchedPREVIOUSArray() As Variant

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Columns.Count = 16 Then
        Application.EnableEvents = False
       
        If currentRACE <> ThisWorkbook.Sheets("Market").Range("A1").Value Then
            ThisWorkbook.Sheets("Market").Range("AE5:AE55,BA5:BH55").ClearContents
        End If
       
        Lrow = ThisWorkbook.Sheets("Market").Range("A55").End(xlUp).Row ' last row with data
        NumberOfSelections = Lrow - 4

        ReDim TotalAmountMatchedArray(NumberOfSelections, 1)
        ReDim TotalAmountMatchedPREVIOUSArray(NumberOfSelections, 1)
        ReDim TempArray(NumberOfSelections, 8)
   
        Set rng = ThisWorkbook.Sheets("Market").Range("BA5:BH" & Lrow)
        TempArray = rng
        Set rng = ThisWorkbook.Sheets("Market").Range("AE5:AE" & Lrow)
        TotalAmountMatchedPREVIOUSArray = rng
        Set rng = ThisWorkbook.Sheets("Market").Range("O5:O" & Lrow)
        TotalAmountMatchedArray = rng
   
        For i = 1 To NumberOfSelections
            If TotalAmountMatchedArray(i, 1) <> TotalAmountMatchedPREVIOUSArray(i, 1) Then
                TempArray(i, 8) = TempArray(i, 7)
                TempArray(i, 7) = TempArray(i, 6)
                TempArray(i, 6) = TempArray(i, 5)
                TempArray(i, 5) = TempArray(i, 4)
                TempArray(i, 4) = TempArray(i, 3)
                TempArray(i, 3) = TempArray(i, 2)
                TempArray(i, 2) = TempArray(i, 1)
                TempArray(i, 1) = TotalAmountMatchedPREVIOUSArray(i, 1)
            End If
        Next i

        ThisWorkbook.Sheets("Market").Range("BA5:BH" & Lrow).Value = TempArray
        ThisWorkbook.Sheets("Market").Range("AE5:AE" & Lrow) = rng.Value ' Copy the values for use in the next refresh in which they will be 'the old values'
       
        currentRACE = ThisWorkbook.Sheets("Market").Range("A1").Value
       
        Application.EnableEvents = True
    End If

End Sub


[mak]

That's it. It is fine now.


I will try later to add some code to clean recordings when market change.
If i don't get it to work I might ask your help again

Thanks!