How would I use VBA to find non matching values and input missing values from one workbook to another?

[Indominus]

Hello. So I have two workbooks that are used for this project. One referenced as pickorder. Another referenced as Routing. Sheet is DWP. Screenshots are attached. The pickorder is the one that needs to be correct since it gets uploaded to a site. Both lists all route codes in column B. . Sometimes however, a couple are not in the Pickorder but they are in dwp.

So what I need is to identify all values in the DWP sheet in Range("B2:B500"). Then identity all matching values in Range("B2:B500") of Pickorder. If it detects one not in Pickorder then input that missing value into the next open row on the Pickorder workbook in column B. So in this case MX115 and MX116. I also attached a screenshot showing what the final result will look like on the Pickorder sheet after. Thank you to anyone willing to help.

 

[mumps]

Make sure that both workbooks are open. Place this macro in the DWP workbook and run it from there. Change the sheet names (in red) to suit your needs.

Sub MatchData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet, arr1 As Variant, arr2 As Variant, Val As String
    Set srcWS = ThisWorkbook.Sheets("Sheet1")
    Set desWS = Workbooks("Pickorder.xlsx").Sheets("Sheet1")
    Dim LastRow As Long
    arr1 = srcWS.Range("B2", srcWS.Range("B" & Rows.Count).End(xlUp)).Value
    arr2 = desWS.Range("B2", desWS.Range("B" & Rows.Count).End(xlUp)).Value
    Set rnglist = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr1, 1)
        Val = arr1(i, 1)
        If Not rnglist.Exists(Val) Then
            rnglist.Add Val, Nothing
        End If
    Next i
    For i = 1 To UBound(arr2, 1)
        Val = arr2(i, 1)
        If Not rnglist.Exists(Val) Then
            With desWS
                .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = Val
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[Indominus]

Make sure that both workbooks are open. Place this macro in the DWP workbook and run it from there. Change the sheet names (in red) to suit your needs.

Sub MatchData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet, arr1 As Variant, arr2 As Variant, Val As String
    Set srcWS = ThisWorkbook.Sheets("Sheet1")
    Set desWS = Workbooks("Pickorder.xlsx").Sheets("Sheet1")
    Dim LastRow As Long
    arr1 = srcWS.Range("B2", srcWS.Range("B" & Rows.Count).End(xlUp)).Value
    arr2 = desWS.Range("B2", desWS.Range("B" & Rows.Count).End(xlUp)).Value
    Set rnglist = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr1, 1)
        Val = arr1(i, 1)
        If Not rnglist.Exists(Val) Then
            rnglist.Add Val, Nothing
        End If
    Next i
    For i = 1 To UBound(arr2, 1)
        Val = arr2(i, 1)
        If Not rnglist.Exists(Val) Then
            With desWS
                .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = Val
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Hello. Thank you for the reply. So the Pickorder workbook has a unique name daily. However, it always has the word “PickOrder” in it. Along with the current date. Could have a word in front of it or could have a “-“. Also capitalization could be different. How would this part be edited?

 

[mumps]

As long as the two workbooks are the only workbooks that are open, this should work:

Sub MatchData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet, WB As Workbook, arr1 As Variant, arr2 As Variant, Val As String
    Set srcWS = ThisWorkbook.Sheets("Sheet1")
    For Each WB In Application.Workbooks
        If WB.Name <> ThisWorkbook.Name Then
            Set desWS = WB.Sheets("Sheet1")
        End If
    Next WB
    arr1 = srcWS.Range("B2", srcWS.Range("B" & Rows.Count).End(xlUp)).Value
    arr2 = desWS.Range("B2", desWS.Range("B" & Rows.Count).End(xlUp)).Value
    Set rnglist = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr1, 1)
        Val = arr1(i, 1)
        If Not rnglist.Exists(Val) Then
            rnglist.Add Val, Nothing
        End If
    Next i
    For i = 1 To UBound(arr2, 1)
        Val = arr2(i, 1)
        If Not rnglist.Exists(Val) Then
            With desWS
                .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = Val
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[Indominus]

As long as the two workbooks are the only workbooks that are open, this should work:

Sub MatchData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet, WB As Workbook, arr1 As Variant, arr2 As Variant, Val As String
    Set srcWS = ThisWorkbook.Sheets("Sheet1")
    For Each WB In Application.Workbooks
        If WB.Name <> ThisWorkbook.Name Then
            Set desWS = WB.Sheets("Sheet1")
        End If
    Next WB
    arr1 = srcWS.Range("B2", srcWS.Range("B" & Rows.Count).End(xlUp)).Value
    arr2 = desWS.Range("B2", desWS.Range("B" & Rows.Count).End(xlUp)).Value
    Set rnglist = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr1, 1)
        Val = arr1(i, 1)
        If Not rnglist.Exists(Val) Then
            rnglist.Add Val, Nothing
        End If
    Next i
    For i = 1 To UBound(arr2, 1)
        Val = arr2(i, 1)
        If Not rnglist.Exists(Val) Then
            With desWS
                .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = Val
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Hello again. So I am getting the compile error, "end if without block if" on the second to the last "End If." I put my sheet name "DWP" in the setWS line and the desWs sheet name I left the same as yours. I am confused on how it will identify my unique named PickOrder workbook and sheet as I do not see it mentioned in the code. Thank you for willing to help me by the way.

 

[mumps]

Oops!! Change that 'End If" to 'End With'.

I am confused on how it will identify my unique named PickOrder workbook and sheet

This part of the code:

For Each WB In Application.Workbooks
        If WB.Name <> ThisWorkbook.Name Then
            Set desWS = WB.Sheets("Sheet1")
        End If
    Next WB

loops through the two open workbooks and checks to see if the workbook name is not the same as the name of the workbook that contains the macro. The workbook happens to be the PickOrder workbook. It then sets the variable 'desWS' to "Sheet1". This will work regardless of the PickOrder workbook name. I hope this makes sense.

 

[Indominus]

Oops!! Change that 'End If" to 'End With'.

This part of the code:

For Each WB In Application.Workbooks
        If WB.Name <> ThisWorkbook.Name Then
            Set desWS = WB.Sheets("Sheet1")
        End If
    Next WB

loops through the two open workbooks and checks to see if the workbook name is not the same as the name of the workbook that contains the macro. The workbook happens to be the PickOrder workbook. It then sets the variable 'desWS' to "Sheet1". This will work regardless of the PickOrder workbook name. I hope this makes sense.

Thank you again for your response. So the problem with this is most of the time the user can or will have more than two workbook open. So therefore, I changed it to


For Each WB In Application.Workbooks
If WB.Name Like PickOrder Then
Set desWS = WB.Sheets("Sheet1")
End If


However I keep getting "object variable or With block variable not set" error when running this. On line

arr2 = desWS.Range("B2", desWS.Range("B" & Rows.Count).End(xlUp)).Value

Once again the sheet and workbook name is unique. I also tried to run your first code with the hard coded worbook and sheet names just to see how the code works. It ran but nothing happened. Any thoughts on this?

 

[mumps]

The code would have to look like this:

For Each WB In Application.Workbooks
      If WB.Name Like "*PickOrder*" Then
             Set desWS = WB.Sheets("Sheet1")
      End If
Next WB

Could upload a copy of your two files to a free site such as www.box.com or www.dropbox.com. Once you do that, mark each file for 'Sharing' and you will be given a link to each file that you can post here. (de-sensitized if necessary).

 

[Indominus]

The code would have to look like this:

For Each WB In Application.Workbooks
      If WB.Name Like "*PickOrder*" Then
             Set desWS = WB.Sheets("Sheet1")
      End If
Next WB

Could upload a copy of your two files to a free site such as www.box.com or www.dropbox.com. Once you do that, mark each file for 'Sharing' and you will be given a link to each file that you can post here. (de-sensitized if necessary).

That code was does not recognize my file for some reason. I uploaded the link to the files on Dropbox here. "Routing" contains the DWP sheet. And the other workbook is the PickOrder. Thank you for helping.

Pickorder

Shared with Dropbox

www.dropbox.com

 

[mumps]

Try:

For Each WB In Application.Workbooks
        If WB.Name Like "*PickOrder*" Then
            Set desWS = WB.Sheets(1)
        End If
    Next WB