VBA code for adding data from a sheet to another

**DocAElstein** · 03-09-2023, 04:14 AM

Hi,
You got very close. In fact, it's better than that: you do have all the correct coding, It's all just as it should be. You modified the coding perfectly to suit the new requirement.

( You may be getting 5 and 6 a bit mixed up in your testing, but I don’t think that is the main problem )

The main thing you are doing wrong is, I think, as follows
The macro ( event coding ) that runs automatically when something ( anything) changes anywhere in a worksheet is pre made and pre defined by Microsoft and they give it the name Worksheet_Change. So Worksheet_Change is a special unique name. We cannot easily make a second macro to do something when a change is made in a worksheet, and if we did, Excel would probably get very confused and crash.

Any coding you want to do anything when a change occurs in a worksheet must go in that single special macro , Worksheet_Change

So you had all the correct coding. You just need to make a few very minor changes so that you can have it all in that single macro.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
' the next few lines arange when excactly our coding is done
    If Target.Cells.Count <> 1 Then Exit Sub ' So I will ignore any multi cell changes
    If Target.Column < 8 Or Target.Column > 9 Then Exit Sub      ' So I will ignore any changes not in column H or colimn I
Dim TgRw As Long: Let TgRw = Target.Row ' the changed target row
    If Target.Column = 8 Then
        ' If we get this far then we changed something in column H (column 8)
    Dim WsD1 As Worksheet: Set WsD1 = ThisWorkbook.Worksheets("Database1") ' I need to have some way to tell Excel when i am referring to the other worksheet, or else Excel will by default think I am referencing this workseet
    
    Rem 1 try to match the  name & Activity & Sub-activity
    Dim arrD1() As Variant: Let arrD1() = WsD1.Evaluate("=A1:A25 & B1:B25 & C1:C25") ' This is a convenient way to get an array of the three things for all rows
    Dim strSrch As String ': Let strSrch = Range("E2").Value & Range("F2").Value & Range("G2").Value ' This gives for example,  "JohnA.1A.1.1"
    'Dim TgRw As Long: Let TgRw = Target.Row ' the changed target row
     Let strSrch = Range("E" & TgRw & "").Value & Range("F" & TgRw & "").Value & Range("G" & TgRw & "").Value
    Dim MtchRw As Long
     Let MtchRw = Application.Match(strSrch, arrD1(), 0) ' this tries to match the correct row in Database1
    
    Rem 2 try now to match the dates
    Dim arrDts() As Variant: Let arrDts() = WsD1.Evaluate("=IF({1},A1:K1)")
    Dim DteV2 As Long: Let DteV2 = Range("D" & TgRw & "").Value2 '  Value 2 gives us the number used by excel for a date
    Dim MtchClm As Long
     Let MtchClm = Application.Match(DteV2, arrDts(), 1) ' this tries to match the correct row in Database1  using a 1 as the third argument im match will get the neartest next date match
    
    Rem 3 use the found row and column to get the final wanted result
     Let WsD1.Cells.Item(MtchRw, MtchClm).Value = Range("H" & TgRw & "").Value
    Else
    ' If it was not column 8 I changed, then it must have been column 9
    Dim WsD2 As Worksheet: Set WsD2 = ThisWorkbook.Worksheets("Database2") ' I need to have some way to tell Excel when i am referring to the other worksheet, or else Excel will by default thinkk I am referencing this workseet
    
    Rem 1 try to match the  name & Activity & Sub-activity
    Dim arrD2() As Variant: Let arrD2() = WsD2.Evaluate("=A1:A25 & B1:B25 & C1:C25") ' This is a convenient way to get an array of the three things for all rows
    Dim strSrch2 As String: Let strSrch2 = Range("E2").Value & Range("F2").Value & Range("G2").Value  ' This gives for example,  "JohnA.1A.1.1"
    'Dim TgRw As Long: Let TgRw = Target.Row ' the changed target row
     Let strSrch2 = Range("E" & TgRw & "").Value & Range("F" & TgRw & "").Value & Range("G" & TgRw & "").Value
    Dim MtchRw2 As Long
     Let MtchRw2 = Application.Match(strSrch2, arrD2(), 0) ' this tries to match the correct row in Database1
    
    Rem 2 try now to match the dates
    Dim arrDts2() As Variant: Let arrDts2() = WsD2.Evaluate("=IF({1},A1:K1)")
    Dim Dte2V2 As Long: Let Dte2V2 = Range("D" & TgRw & "").Value2 '  Value 2 gives us the number used by excel for a date
    Dim MtchClm2 As Long
     Let MtchClm2 = Application.Match(Dte2V2, arrDts2(), 1) ' this tries to match the correct row in Database2  using a 1 as the third argument im match will get the neartest next date match
    
    Rem 3 use the found row and column to get the final wanted result
     Let WsD2.Cells.Item(MtchRw2, MtchClm2).Value = Range("I" & TgRw & "").Value
    End If
End Sub