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

cizzett

Board Regular
Joined
Jan 10, 2019
Messages
121
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

Code:
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
 

Some videos you may like

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,116
Office Version
  1. 365
Platform
  1. Windows
How about
Code:
   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

Board Regular
Joined
Jan 10, 2019
Messages
121
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,116
Office Version
  1. 365
Platform
  1. Windows
Try
Code:
            Ws.Rows(i + 2).Copy Nws.Range("A" & Rows.Count).End(xlUp).Offset(1)
 

cizzett

Board Regular
Joined
Jan 10, 2019
Messages
121

ADVERTISEMENT

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

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,116
Office Version
  1. 365
Platform
  1. Windows
Ok, how about
Code:
           Nws.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 25).Value = Ws.Range("A" & i + 2).Resize(, 25).Value
 

cizzett

Board Regular
Joined
Jan 10, 2019
Messages
121
Thats It Man, You are awesome!!!!!

For anyone interested heres the final codes.
Thanks Fluff

Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,116
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,108,678
Messages
5,524,241
Members
409,566
Latest member
MickB

This Week's Hot Topics

Top