Follow

Keep Up to Date with the Most Important News

By pressing the Subscribe button, you confirm that you have read and are agreeing to our Privacy Policy and Terms of Use
Contact

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

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.

MEDevel.com: Open-source for Healthcare and Education

Collecting and validating open-source software for healthcare, education, enterprise, development, medical imaging, medical records, and digital pathology.

Visit Medevel

>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
Add a comment

Leave a Reply

Keep Up to Date with the Most Important News

By pressing the Subscribe button, you confirm that you have read and are agreeing to our Privacy Policy and Terms of Use

Discover more from Dev solutions

Subscribe now to keep reading and get access to the full archive.

Continue reading