Why won't this VBA code write or update records to a new tab?

Advertisements

Here is the code:

Private Sub Query1_Change(ByVal Target As Range)
    Dim myRange As Range
    Dim myCell As Range
    Dim wsComments As Worksheet
    Dim wsQuery1 As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim foundMatch As Boolean
    
    Set wsComments = ThisWorkbook.Sheets("Comments")
    Set wsQuery1 = ThisWorkbook.Sheets("Query1")
    
    If Target.Row < 2 Or (Target.Column <> 31 Or Target.Column <> 32 Or Target.Column <> 33 Or Target.Column <> 34) Then Exit Sub
    
    'Check if there is a matching value in column A of "Comments"
    lastRow = wsComments.Cells(wsComments.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        If wsComments.Cells(i, "A").Value = wsQuery1.Cells(Target.Row, "C").Value Then
            foundMatch = True
            Exit For
        End If
    Next i
    MsgBox
    'If no match is found, create a new record in "Comments"
    If Not foundMatch Then
        lastRow = wsComments.Cells(wsComments.Rows.Count, "A").End(xlUp).Row + 1
        wsComments.Cells(lastRow, "A").Value = wsQuery1.Cells(Target.Row, "C").Value
        wsComments.Cells(lastRow, "B").Value = wsQuery1.Cells(Target.Row, "AE").Value
        wsComments.Cells(lastRow, "C").Value = wsQuery1.Cells(Target.Row, "AF").Value
        wsComments.Cells(lastRow, "D").Value = wsQuery1.Cells(Target.Row, "AG").Value
        wsComments.Cells(lastRow, "E").Value = wsQuery1.Cells(Target.Row, "AH").Value
    
    'If a match is found, update the existing record in "Comments"
    Else
        wsComments.Cells(i, "B").Value = wsQuery1.Cells(Target.Row, "AE").Value
        wsComments.Cells(i, "C").Value = wsQuery1.Cells(Target.Row, "AF").Value
        wsComments.Cells(i, "D").Value = wsQuery1.Cells(Target.Row, "AG").Value
        wsComments.Cells(i, "E").Value = wsQuery1.Cells(Target.Row, "AH").Value
    End If
    
End Sub

I’m perplexed – what are some ways for me to troubleshoot? I can’t seem to figure out why this isn’t working.

I am expecting that when I update column AE, AF, AG, or AH, it will first check to see if a record with the value of column C exists and if so, update the corresponding column, otherwise, it will write a new record.

>Solution :

Working for me:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsComments As Worksheet, id, rw As Range, m
    
    If Target.Rows.Count > 1 Then Exit Sub 'only single-row updates...
    If Target.Row < 2 Then Exit Sub
    If Application.Intersect(Target, Me.Range("AE:AH")) Is Nothing Then Exit Sub
    Set rw = Target.EntireRow
    
    Set wsComments = ThisWorkbook.Sheets("Comments")
    
    id = rw.Columns("C").Value
    m = Application.Match(id, wsComments.Columns("A"), 0) 'check for match
    'if no match then use next empty row in Col A
    If IsError(m) Then m = wsComments.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    With wsComments.Rows(m)
        .Columns("A") = id
        .Columns("B").Resize(1, 4).Value = rw.Range("AE1:AH1").Value 'AE1:AH1 is relative to `rw`
    End With
    
End Sub

Leave a ReplyCancel reply