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