CODEWITHSUNDEEP
vbaexcel
rdan1
rdan1

Reputation: 17

Find a range of multiple cells in another sheet

I am trying to enhance my current script. Sheet1 and Sheet2 contain only filepath names in column A. If a filepath in Sheet2 isn't found in Sheet1, it is copied over to sheet 3. 

'row counter
x = 1
'Initiate Variables
Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("Sheet1")
Set ws2 = wb.Sheets("Sheet2")

'create a new sheet 3, delete old one if it exists
If Sheets.Count > 2 Then
Application.DisplayAlerts = False
    Sheets(3).Delete
Application.DisplayAlerts = False
End If

Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Sheet3"

Set ws3 = wb.Sheets("Sheet3")

'Get row count to know how many times to loop
rowCount2 = ws2.Range("A1").End(xlDown).Row

'compare filepaths from sheet2 to sheet1
'if there is a difference, that difference is put on sheet 3
For i = 1 To rowCount2
    FilePath = ws2.Cells(i, 1)
    With Sheets("Sheet1").Range("A:A")
        Set CellId = .Find(What:=FilePath, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not CellId Is Nothing Then
        'do nothing if filepath is found in both sheets
        Else
            'put the filepath from file2 not found in file1, into
            'sheet 3
            ws3.Cells(x, 1) = FilePath
            x = x + 1
        End If
    End With
Next I

What I want to do, is be able to reference a range of cells to compare instead of just from column A. Instead of just file paths in column A, there will be last saved by in column B, Last opened by in column C, etc. So instead of just checking for difference in filepath, I want differences in multiple columns. So there might be the same filepaths, but it was opened by someone different on another day. I need to grab that difference. I don't know how to reference the range of multiple cells. So I need to fix up this section of code:

FilePath = ws2.Cells(i, 1)
With Sheets("Sheet1").Range("A:A")

And if there is an easier way to approach this I am open to advice.

Upvotes: 0

Views: 145

Answers (2)

Scott Holtzman
Scott Holtzman

Reputation: 27249

In the 'do nothing if filepath is found in both sheets section, place something like this:

k = ws2.Cells(1,ws2.Columns.Count).End(xlToleft).Column
For j = 2 to k
    If ws2.Cells(i, j).Value <> CellId.Offset(, j - 1).Value Then 
       CellId.EntireRow.Copy ws.Cells(x,1).EntireRow
       x = x +1
       Exit For
       'or whatever code you need to move to sheet3 
    End If
Next

Upvotes: 1

user6432984
user6432984

Reputation:

I use a Dictionary when comparing multiple list. This way I only iterate over each list one time.

Sub CopyMissingFileNames()
    Dim filepath As Range, Target As Range
    Dim dictFilePaths As Object
    Set dictFilePaths = CreateObject("Scripting.Dictionary")

    With Worksheets("Sheet1")

        For Each filepath In .Range("A2", .Range("A" & Rows.Count).End(xlUp))

            If Not dictFilePaths.Exists(filepath.Text) Then dictFilePaths.Add filepath.Text, ""
        Next

    End With


    With Worksheets("Sheet2")

        For Each filepath In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            If Not dictFilePaths.Exists(filepath.Text) Then
                Set Target = Worksheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1)

                filepath.EntireRow.Copy Target
            End If
        Next

    End With



End Sub

Upvotes: 0

Related Questions