How to compare 2 worksheets columns from user selection excel VBA?

Question

i'm trying to compare 2 worksheets and i have the below code that is working for me but it's kind of slow and also i can't get a dialog box to allow user to select the compare sources from both sheets and also i can't get it to select a column where to output the result. All is done in code but need it to be more flexible in excel front of house rather then editing all the times the code where to find the source of data. First sub will compare sheet1 against sheet2 and write the result in sheet 1 at the end of the table. Second sub will do the oppose compare sheet2 against sheet1 and write the result in sheet2 at the end of the table. Any help or guidance on how to achieve the above will be much appreciated.

Sub sample1()

Dim i, lastRow, currentRow As Long
Dim foundMatch As Range
Dim srcCriteria As String

Dim wsDest As Worksheet
Dim wsSrc As Worksheet

Set wsDest = ActiveWorkbook.Sheets("Sheet1")
Set wsSrc = ActiveWorkbook.Sheets("Sheet2")

lastRow = wsDest.Range("J" & Rows.Count).End(xlUp).Row

For i = 2 To lastRow
    srcCriteria = wsDest.Range("J" & i).value
    With wsSrc
    Set foundMatch = .Columns(3).Find(What:=srcCriteria, After:=.Cells(1, 3), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)  'finds a match
    End With
If foundMatch Is Nothing Then
    wsDest.Range("S" & i).value = "0"
Else
With wsSrc
    currentRow = .Columns(3).Find(What:=srcCriteria, After:=.Cells(1, 3), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
    End With
    wsDest.Range("S" & i).value = wsSrc.Range("I" & currentRow).value

 End If
Next i


End Sub

Sub sample2()

Dim i, lastRow, currentRow As Long
Dim foundMatch As Range
Dim srcCriteria As String

Dim wsDest As Worksheet
Dim wsSrc As Worksheet

Set wsDest = ActiveWorkbook.Sheets("Sheet1")
Set wsSrc = ActiveWorkbook.Sheets("Sheet2")

lastRow = wsSrc.Range("C" & Rows.Count).End(xlUp).Row


For i = 2 To lastRow
    srcCriteria = wsSrc.Range("C" & i).value

    With wsDest
    Set foundMatch = .Columns(10).Find(What:=srcCriteria, After:=.Cells(1, 10), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)  'finds a match
    End With

If foundMatch Is Nothing Then
    wsSrc.Range("M" & i).value = "To remove"

Else
With wsDest
    currentRow = .Columns(10).Find(What:=srcCriteria, After:=.Cells(1, 10), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
    End With

    wsSrc.Range("M" & i).value = wsDest.Range("L" & currentRow).value

 End If
Next i


End Sub

Why can't you just use Excel's built-in functionality for comparing worksheets, instead of redeveloping the feature from scratch? There are many examples (on this site and others) of how to compare sheets/workbooks, both with VBA, or better yet, with existing functionality, such as this answer, by me, a few hours ago. — ashleedawg

David wyatt David wyatt · Accepted Answer · 2018-01-28T18:20:17

if you want to speed up your code there a couple of quick wins

Application.ScreenUpdating=false
Application.Calculation = xlCalculationMannual

This will stop the screen updating and stop all calculations, just remember to turn calc back on at the end of the sub with this

Application.Calculation = xlCalculationAutomatic

as for your second question, the easiest way would be to input the sheet names

Dim sht1 As String, sht2 As String

sht1 = Application.InputBox("please input your first sheets name")
sht2 = Application.InputBox("please input your second sheets name")
Set wsDest = ActiveWorkbook.Sheets(sht1)
Set wsSrc = ActiveWorkbook.Sheets(sht2)

or you could use an input box to select a cell in each worksheet and use that to get the sheet name

Dim sht1 As String, sht2 As String
Dim rng1 As Range, rng2 As Range

Set rng1 = Application.InputBox("Select cell in your first sheet:", Type:=8)
Set rng2 = Application.InputBox("Select cell in your second sheet:", Type:=8)
sht1 = rng1.Parent.Name
sht2 = rng2.Parent.Name
Set wsDest = ActiveWorkbook.Sheets("sht1")
Set wsSrc = ActiveWorkbook.Sheets("sht2")

if you want to pick your range use

Set rng1 = Application.InputBox("Select your first range:", Type:=8)
    Set rng2 = Application.InputBox("Select your second range:", Type:=8)

LastRow = rng1.Rows.Count

For i = 2 To LastRow
    srcCriteria = rng1(10 & i).Value 'column 10 = j

How to compare 2 worksheets columns from user selection excel VBA?

1 Answers