compare cells from one spreadsheet to another and transfering data

instanceoftime

Board Regular
Joined
Mar 23, 2011
Messages
103
Spreadsheet A (Items) and Spreadsheet incoming

I would like help figuring out code that will allow me to choose which file to open and compare.

(open worksheet would be a master inventory list and I would open an incoming inventory list and search it for non-matching products (NEW) to the master sheet)

What I am comparing is cell (i,A), (i,C) of the incoming spreadsheet to any row in the masterlist and if it isn't on the masterlist then add the whole row (A through F)

below is a similar search within the sheet but for only 1 cell and from a user textbox.

Code:
Sub SearchUPC()
    
    Dim NotFound As Integer
    Dim arr As Variant
    Dim I As Long
    Dim str1 As String, str2 As String, str3 As String, str4 As String, str5 As String, str6 As String
    




    NotFound = 0
    
    ActiveWorkbook.Sheets("Items").Activate
    
    UPCNumber = txtbxUPCNumber.Text


        
                With ActiveSheet
                    arr = .Range("A1:H" & .Cells(.Rows.Count, "G").End(xlUp).Row)
                End With
        
                For I = 1 To UBound(arr)
                    If arr(I, 7) = UPCNumber Then
                        str1 = IIf(str1 = "", arr(I, 1), str1 & "|" & arr(I, 1))
                        str2 = IIf(str2 = "", arr(I, 2), str2 & "|" & arr(I, 2))
                        str3 = IIf(str3 = "", arr(I, 3), str3 & "|" & arr(I, 3))
                        str4 = IIf(str4 = "", arr(I, 4), str4 & "|" & arr(I, 4))
                        str5 = IIf(str5 = "", arr(I, 7), str5 & "|" & arr(I, 7))
                        str6 = IIf(str6 = "", arr(I, 8), str6 & "|" & arr(I, 8))
                    End If
                Next
        
                If str1 = "" Then
                    'not found
                Else
                    'found
                End If    
    
End Sub

for example below is Item worksheet

John W Smith 509555555 99202
Jim H Smith 095554444 99203
John L Henry 509554333 99204

so for example below is incoming worksheet

Sandy j Brown 5555555 99201
Jean Y Simmon 4444444 99206
Jim H Smith 5095555 99202

Item worksheet would open up Incoming worksheet and "grab" Sandy and Brown and search itself to see if that data is already there and if not write the whole row to itself (Item worksheet) (it would find Jim Smith and bypass it)
 
Last edited:

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Try this:

Read the comments proceeded with <<<< where your input may be required
Code:
Sub SearchNewData()
    
    Dim bFound As Boolean
    Dim vMast As Variant, vInc As Variant, vOut As Variant
    Dim lM As Long, lI  As Long, lO As Long, UBm As Long, _
        UBi As Long, lj As Long, UBm2 As Long
    Dim str1 As String, str2 As String, str3 As String, _
        str4 As String, str5 As String, str6 As String
    Dim wsMast As Worksheet, wsIncom As Worksheet
    Dim wbMastWB As Workbook, wbIncomWB As Workbook


    Set wbMastWB = ThisWorkbook
    Set wsMast = wbMastWB.Sheets("Item") ' <<< Amend name of sheet holding the master data
    
    ' open the incoming workbook
    Set wbIncomWB = OpenWorkbook
    If wbIncomWB Is Nothing Then Exit Sub ' user pressed cancel
    
    Set wsIncom = wbIncomWB.Sheets(1) '<<< Assuming the sheet with the data to be checked _
                                           is always first sheet of the workbook




    ' Now read the entire master table into an array
    With wsMast
        vMast = .Range("A1").CurrentRegion.Value
    End With
    UBm = UBound(vMast, 1)  ' number of rows
    UBm2 = UBound(vMast, 2) ' number of columns
    ' dim the output array which will hold new items. As it needs to be resized, _
      and this can only be done on the last dimension, we dim it transposed: _
      vOut(Columns, Rows) with one row at the start
    ReDim vOut(1 To UBm2, 1 To 1)
    lO = 1
    ' And read the incoming table into an array
     With wsIncom
        vInc = .Range("A1").CurrentRegion.Value
     End With
    UBi = UBound(vInc, 1)
    
    ' close the incoming workbook
    wbIncomWB.Close
    
    For lI = 1 To UBi
        str1 = vInc(lI, 1)
        str2 = vInc(lI, 2)
        bFound = False
        
        For lM = 1 To UBm
            If StrComp(str1, vMast(lM, 1)) = 0 Then
                ' First name found, check second name
                If StrComp(str2, vMast(lM, 2)) = 0 Then
                    ' Second name found, exit for to go to next name from Incoming
                    bFound = True
                    Exit For
                End If
            End If
            
        Next lM
        If Not bFound Then
            ' First/second name combination not found, add it to the output array
            For lj = 1 To UBm
                vOut(lj, lO) = vInc(lI, lj)
            Next lj
            lO = lO + 1
            ' now increase the size of the output array, keeping existing contents
            ReDim Preserve vOut(1 To UBm2, 1 To lO)
        End If
    Next lI
    ' Now output the output array to the end of the masterlist
    With wsMast
        .Range("A1").Offset(UBm, 0).Resize(UBound(vOut, 2), UBm2).Value = _
                Application.WorksheetFunction.Transpose(vOut)
    End With
    
    
    ' clean up
    Set wsMast = Nothing
    Set wsIncom = Nothing
    Set wbMastWB = Nothing
    Set wbIncomWB = Nothing
End Sub


Function OpenWorkbook() As Workbook
    Dim fd As FileDialog
    Dim FileName As String
    
    Set fd = Application.FileDialog(msoFileDialogOpen)
    
    'the number of the button chosen
    Dim FileChosen As Integer
    FileChosen = fd.Show
    fd.Title = "Choose workbook"
    fd.InitialFileName = "" ' <<< if incoming workbooks have a particular name you can _
                                  put this here
    fd.InitialView = msoFileDialogViewList
    'show Excel workbooks and macro workbooks
    fd.Filters.Clear
    fd.Filters.Add "Excel workbooks", "*.xlsx"
    fd.Filters.Add "Excel macros", "*.xlsm"
    fd.FilterIndex = 1
    fd.ButtonName = "Choose this file"
    If FileChosen <> -1 Then
        'didn't choose anything (clicked on CANCEL)
        Set OpenWorkbook = Nothing
    Else
        'get file, and open it (NAME property
        'includes path, which we need)
        FileName = fd.SelectedItems(1)
        Set OpenWorkbook = Workbooks.Open(FileName)
    End If
End Function
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,853
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top