MrMegadeth
MrMegadeth

Reputation: 31

Position in Target Array using For Each (Excel VBA)

I am trying to trap the changes that a user makes on a sheet.

I have my worksheet_change event setup but the issue is what if the Target.Range is larger than a single cell?

Basically, I need to evaluate each and every cell change to test for validity using a function. My issue is the Target.Range can be any size of course and the function to test for validity looks at the surrounding cells.

I was trying to trap the addresses of the changed cells using something like this:

i = 1
j = 1

For Each aCell In Target
    DiffAddys(i, j) = aCell.Address
    NewValues(i, j) = aCell.Value2
    If i < Target.Rows.Count Then i = i + 1
    If j < Target.Columns.Count Then j = j + 1
Next

That way I can trap the cells' address and then use aCell.Row or aCell.Column, etc. but this fails if the Target.Range is bigger than 2 columns since the i index grows faster than it should.

Is there anyway to find the position of "aCell" in the Target range as it is looped by the For Each? Or is it just best to trust that For Each always goes 1,1 1,2 1,3 2,1 2,2, etc.?

Any better methods? Maybe just copy the address of each aCell into a 1D array that is equal to rows*columns of the Target.Range that way the i/j indexes are irrelevant - and then process this 1D array instead of a 2D array?

Thanks, BT

Upvotes: 2

Views: 4326

Answers (2)

MrMegadeth
MrMegadeth

Reputation: 31

Thanks to all for the suggestions. I just went ahead and took my own advice and went with the 1D array to store the addresses of the changed cells.

If Range("aq" & Target.Row).Value <> "p" And Target.Cells.Count <= 1 Then 
    Range("aq" & Target.Row).Value = 1
    Application.EnableEvents = True
    Exit Sub
End If

Application.ScreenUpdating = False

ReDim OldValues(1 To (Target.Rows.Count * Target.Columns.Count))
ReDim NewValues(1 To (Target.Rows.Count * Target.Columns.Count))
ReDim DiffAddys(1 To (Target.Rows.Count * Target.Columns.Count))

i = 1

For Each aCell In Target
    DiffAddys(i) = aCell.Address
    NewValues(i) = aCell.Value2
    If i < (Target.Rows.Count * Target.Columns.Count) Then i = i + 1
Next

Application.Undo 'turn back time

For i = 1 To UBound(NewValues, 1) 'rows
        OldValues(i) = Sheet5.Range(DiffAddys(i)).Value
Next i

Upvotes: 0

kolcinx
kolcinx

Reputation: 2233

More info about what you need to do with the arrays and how you are doing it would help. But as for what you posted... Something like you suggested, using 1D arrays, should do the trick :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim DiffAddys() As String, NewValues() As Variant

Application.EnableEvents = False

ReDim DiffAddys(Target.Cells.Count)
ReDim NewValues(Target.Cells.Count)

i = 1 'it is generaly not recommended to start array indexes on 1

For Each aCell In Target.Cells

    DiffAddys(i) = aCell.Address
    NewValues(i) = aCell.Value2
    i = i + 1

Next aCell

Application.EnableEvents = True

End Sub

Or you could put the aCell.Address and aCell.Value2 into one 2D array.

Upvotes: 0

Related Questions