Trigger VBA on cell change error

[gorem]

Hi all,

I'm using the macro below to detect cell changes in a column. If a change is detected, the address of the change is used to build an array of related rows to which I want to apply another macro. This is working beautifully when I either enter a value in a cell or clear the contents of a cell. However, when I select two cells in the column and clear their contents, Excel does not detect a change and there doesn't apply the second macro. Does anyone have a creative solution to force Excel to recognize this scenario as a cell change? Thanks in advance!

Sub Worksheet_Change(ByVal target As Range)


    If Not Application.Intersect(target, Range("table_1[Confirmation]")) Is Nothing Then


    Call newarray(target)


    End If


End Sub

 

[Andrew Poulsom]

The code fires fine for me if I change more than one cell provided that at least one of them is in the Confirmation column. Maybe it's your newarray procedure that can't cope with more than one cell. I tested your code like this:

Sub Worksheet_Change(ByVal target As Range)
    If Not Application.Intersect(target, Range("table_1[Confirmation]")) Is Nothing Then
        MsgBox "Change"
'        Call newarray(target)
    End If
End Sub

 

[gorem]

Great thought, Andrew - I think you're right! Would love some suggestions on how to revise newarray.

Essentially, the changed range ("target") is passed through to the newarray sub. The value 4 columns to the right of "target" is a unique identifier which I then use to grab a comma-separated string of cell addresses from another sheet. I convert that string into an array and loop some functions which highlight rows/cells according to a variety of rules. What I want to do at a high level is detect the unique identifier associated with the workbook change, find all the rows which contain that unique identifier (I have those stored in the sheet i lookup; i know i could loop to find them but this has proven to be faster so far), and highlight rows according to some criteria. Apologies for what is probably very sloppy VBA; I only started trying to write VBA a month or two ago. Newarray is below; thanks again for your help.

Sub newarray(target)


    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    
    Dim mylist() As String
    Dim arrayposition As Long
    Dim mystring As String
    Dim p As String
    Dim q As Range
    
    Set q = ThisWorkbook.Sheets("Sheet4").Range("A:E")
    p = target.Offset(0, 4)


    mystring = Application.VLookup(p, q, 5, False)
    mylist = Split(mystring, ",")
    
    For arrayposition = LBound(mylist) To UBound(mylist)
        Dim r As Long
        r = Right(mylist(arrayposition), Len(mylist(arrayposition)) - 3) + 1
        
    Dim wb As Workbook
    Dim sheet_1 As Worksheet
    Dim table_1 As ListObject


    Set wb = ThisWorkbook
    Set sheet_1 = wb.Sheets("sheet1")
    Set table_1 = sheet_1.ListObjects("table_1")
        
    If (sheet_1.Range("AH" & r).Value = 1 Or sheet_1.Range("AH" & r).Value = 1) Then
        sheet_1.Rows(r).Columns("A:O").Interior.ColorIndex = 37
    End If
    
    If (sheet_1.Range("AH" & r).Value > 1 Or sheet_1.Range("AH" & r).Value > 1) Then
        sheet_1.Rows(r).Columns("A:O").Interior.ColorIndex = 22
    End If


    If (sheet_1.Range("AH" & r).Value = 0 Or sheet_1.Range("AH" & r).Value = 0) Then
        sheet_1.Rows(r).Columns("A:O").Interior.ColorIndex = xlNone
                If UCase(sheet_1.Cells(r, 1).Value) <> UCase(sheet_1.Cells(r, 8).Value) Then
                    sheet_1.Cells(r, 1).Interior.ColorIndex = 36
                End If
                If UCase(sheet_1.Cells(r, 1).Value) <> UCase(sheet_1.Cells(r, 8).Value) Then
                    sheet_1.Cells(r, 8).Interior.ColorIndex = 36
                End If
                If UCase(sheet_1.Cells(r, 2).Value) <> UCase(sheet_1.Cells(r, 9).Value) Then
                    sheet_1.Cells(r, 2).Interior.ColorIndex = 36
                End If
                If UCase(sheet_1.Cells(r, 2).Value) <> UCase(sheet_1.Cells(r, 9).Value) Then
                    sheet_1.Cells(r, 9).Interior.ColorIndex = 36
                End If
                If sheet_1.Cells(r, 3).Value <> sheet_1.Cells(r, 10).Value Then
                    sheet_1.Cells(r, 3).Interior.ColorIndex = 36
                End If
                If sheet_1.Cells(r, 3).Value <> sheet_1.Cells(r, 10).Value Then
                    sheet_1.Cells(r, 10).Interior.ColorIndex = 36
                End If
                If UCase(sheet_1.Cells(r, 4).Value) <> UCase(sheet_1.Cells(r, 11).Value) Then
                    sheet_1.Cells(r, 4).Interior.ColorIndex = 36
                End If
                If UCase(sheet_1.Cells(r, 4).Value) <> UCase(sheet_1.Cells(r, 11).Value) Then
                    sheet_1.Cells(r, 11).Interior.ColorIndex = 36
                End If
                If UCase(sheet_1.Cells(r, 5).Value) <> UCase(sheet_1.Cells(r, 12).Value) Then
                    sheet_1.Cells(r, 5).Interior.ColorIndex = 36
                End If
                If UCase(sheet_1.Cells(r, 5).Value) <> UCase(sheet_1.Cells(r, 12).Value) Then
                    sheet_1.Cells(r, 12).Interior.ColorIndex = 36
                End If
    End If
        
    Next arrayposition
    
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    
End Sub

I think I need to loop through the various cells that make up "target" to build my array(s) in the event "target" is a multi-cell range.

 

[gorem]

Hello again - thanks for getting me started Andrew. I just figured it out! I needed an extra for each loop for "target." Simple change!