VBA compliance in Excel
I need to compare sheet 1 and sheet 2: two columns.
If both columns match in both sheets 1 and 2, then it will display on sheet3 showing a match. Unfortunately I can only match one column and then display in sheet 3.
here is my code:
Sub FindMatches()
Dim Sht1Rng As Range
Dim Sht2Rng As Range
Set Sht1Rng = Worksheets("Sheet1").Range("B1", Worksheets("Sheet1").Range("B65536").End(xlUp))
Set Sht2Rng = Worksheets("Sheet2").Range("H1", Worksheets("Sheet2").Range("H65536").End(xlUp))
For Each c In Sht1Rng
Set d = Sht2Rng.Find(c.Value, LookIn:=xlValues)
If Not d Is Nothing Then
Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).Value = c.Value
Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(0, 1).Value = c.Offset(0, 2).Value
Set d = Nothing
End If
Next c
End Sub
source to share
To show the results in "Sheet3", you need both columns in "Sheet1" and "Sheet2" to have the same value.
So you can use Application.Match
, this will simplify and shorten your code:
Option Explicit
Sub FindMatches()
Dim Sht1Rng As Range
Dim Sht2Rng As Range
Dim C As Range
With Worksheets("Sheet1")
Set Sht1Rng = .Range("B1", .Range("B65536").End(xlUp))
End With
With Worksheets("Sheet2")
Set Sht2Rng = .Range("H1", .Range("H65536").End(xlUp))
End With
For Each C In Sht1Rng
If Not IsError(Application.Match(C.Value, Sht2Rng, 0)) Then ' <-- successful match in both columns
Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).Value = C.Value
Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(0, 1).Value = C.Offset(0, 2).Value
End If
Next C
End Sub
source to share
I added an imaginary one to your code Sht2Rng2
. Now, if a match is found in Sht2Rng
, the second search is done in Sht2Rng2
, and the value written to Sheet3 only if that second one is found. Modify the definition Sht2Rng2
as needed.
Sub FindMatches()
Dim Sht1Rng As Range
Dim Sht2Rng As Range, Sht2Rng2 As Range
Dim C As Range, D As Range
Dim R As Long
With Worksheets("Sheet1")
Set Sht1Rng = .Range("B1", .Range("B65536").End(xlUp))
End With
With Worksheets("Sheet2")
Set Sht2Rng = .Range("H1", .Range("H65536").End(xlUp))
Set Sht2Rng2 = .Range("J1", .Range("H65536").End(xlUp))
End With
For Each C In Sht1Rng
Set D = Sht2Rng.Find(C.Value, LookIn:=xlValues)
If Not D Is Nothing Then
Set D = Sht2Rng2.Find(C.Value, LookIn:=xlValues)
If Not D Is Nothing Then
With Worksheets("Sheet3")
R = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(R, 1).Value = C.Value
.Cells(R + 1, 1).Value = C.Offset(0, 2).Value
End With
End If
End If
Next C
End Sub
You have to add Option Explicit
at the top of your code sheet and declare all variables. It will save you one day, pulling your hair for hours.
source to share