excel vba two way match, can this be tweaked to use two way matching?

[cizzett]

So I had a great deal of help coming up with this code which works flawlessly but I was wanting to know if anyone can see a way to do two changes, 1) Make it match both column A and column L so be a match and B if no match is found then add the record to the next available row?

Thanks in advance

Sub UpdateRun()    Application.ScreenUpdating = False
    Application.EnableEvents = False
	Dim Wb As Workbook, Wbk As Workbook, Ws As Worksheet, Nws As Worksheet, RDPiv As Worksheet
		Set Wb = ThisWorkbook
		Set Ws = Wb.Sheets("Today")
		
    If Ws.Range("E3") > 0 Then
    
            Set Wbk = Workbooks.Open(Fl.Range("B9").Value)
            Set Nws = Wbk.Sheets("Data")
            Set RDPiv = Wbk.Sheets("Pivot")
    Dim path As String, Val As String, i As Long, v1, v2
                
'----------------------------Update status, cause, and comments for current records---------------------------
    v1 = Ws.Range("A3", Ws.Range("A" & Rows.Count).End(xlUp)).Value
    v2 = Nws.Range("A3", Nws.Range("A" & Rows.Count).End(xlUp)).Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(v2, 1)
            Val = v2(i, 1)
            If Not .Exists(Val) Then
                .Add Val, i + 2
            End If
        Next i
        For i = 1 To UBound(v1, 1)
            Val = v1(i, 1)
            If .Exists(Val) Then
                Nws.Cells(Nws.Range("A:A").Find(Val, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row, "B") = Ws.Cells(i + 2, "B")
                Nws.Cells(Nws.Range("A:A").Find(Val, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row, "C") = Ws.Cells(i + 2, "C")
                Nws.Cells(Nws.Range("A:A").Find(Val, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row, "T") = Ws.Cells(i + 2, "T")
            End If
        Next i
    End With
    '-----------------Refresh's Pivot table data-----------------------
   RDPiv.Activate
   ActiveWorkbook.RefreshAll
      Wbk.Close True
    Wb.Save
    End If
    Wb.RefreshAll
    Application.EnableEvents = True
    Application.ScreenUpdating = True


    End Sub

 

[Fluff]

How about

   v1 = Ws.Range("A3", Ws.Range("A" & Rows.Count).End(xlUp).Offset(, 11)).Value
   v2 = Nws.Range("A3", Nws.Range("A" & Rows.Count).End(xlUp).Offset(, 11)).Value
   With CreateObject("Scripting.Dictionary")
      For i = 1 To UBound(v2, 1)
          Val = v2(i, 1) & "|" & v2(i, 12)
          If Not .Exists(Val) Then
              .Add Val, i + 2
          End If
      Next i
      For i = 1 To UBound(v1, 1)
         Val = v1(i, 1) & "|" & v1(i, 12)
         If .Exists(Val) Then
             Nws.Cells(.Item(Val), "B") = Ws.Cells(i + 2, "B")
             Nws.Cells(.Item(Val), "C") = Ws.Cells(i + 2, "C")
             Nws.Cells(.Item(Val), "T") = Ws.Cells(i + 2, "T")
         Else
            Nws.Range("A" & Rows.Count).End(xlUp).Offset(1).Value = v1(i, 1)
         End If
      Next i
   End With

 

[cizzett]

The update seems to work perfectly but adding the records is only adding the first column, I need to add A:X when the record isn't there.

Yours looks simpler than mine BTW....... One Day Fluff, I told you I hope to be like you.

So How would you tweak it to encompass A:X when adding a new record?

 

[Fluff]

Try

            Ws.Rows(i + 2).Copy Nws.Range("A" & Rows.Count).End(xlUp).Offset(1)

 

[cizzett]

Hmmmmm This brings everything including formatting etc and causes a bunch of pop ups......

 

[Fluff]

Ok, how about

           Nws.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 25).Value = Ws.Range("A" & i + 2).Resize(, 25).Value

 

[cizzett]

Thats It Man, You are awesome!!!!!

For anyone interested heres the final codes.
Thanks Fluff

Sub UpdateRun()    Application.ScreenUpdating = False
             Call Dec
    If Ws.Range("E3") > 0 Then
    
            Set Wbk = Workbooks.Open(Fl.Range("B9").Value)
            Set Nws = Wbk.Sheets("Data")
            Set RDPiv = Wbk.Sheets("Pivot")
    Dim path As String, Val As String, i As Long, v1, v2
                
'----------------------------Update status, cause, and comments for current records---------------------------
 v1 = Ws.Range("A3", Ws.Range("A" & Rows.Count).End(xlUp).Offset(, 11)).Value
   v2 = Nws.Range("A3", Nws.Range("A" & Rows.Count).End(xlUp).Offset(, 11)).Value
   With CreateObject("Scripting.Dictionary")
      For i = 1 To UBound(v2, 1)
          Val = v2(i, 1) & "|" & v2(i, 12)
          If Not .Exists(Val) Then
              .Add Val, i + 2
          End If
      Next i
      For i = 1 To UBound(v1, 1)
         Val = v1(i, 1) & "|" & v1(i, 12)
         If .Exists(Val) Then
             Nws.Cells(.Item(Val), "B") = Ws.Cells(i + 2, "B")
             Nws.Cells(.Item(Val), "C") = Ws.Cells(i + 2, "C")
             Nws.Cells(.Item(Val), "T") = Ws.Cells(i + 2, "T")
         Else
           Nws.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 24).Value = Ws.Range("A" & i + 2).Resize(, 24).Value
         End If
      Next i
   End With
    '-----------------Refresh's Pivot table data-----------------------
   RDPiv.Activate
   ActiveWorkbook.RefreshAll
      Wbk.Close True
    Wb.Save
    End If
    Wb.RefreshAll
    Application.ScreenUpdating = True


    End Sub

 

[Fluff]

You're welcome & thanks for the feedback