 ExcelExperts.comExcel Consultancy, VBA Consultancy, Training and Tips Call:+442081234832 |
|
Excel / VBA ConsultancyFree Training VideosFree SpreadsheetsExcel / VBA JobsNavigationWho's onlineThere are currently 0 users and 595 guests online.
New Excel Experts
Current Excel / VBA Jobs |
Matching cellsHi, I would like to find VBA code for the following actions. I would like to match Col D in sheet 2 with Col E in sheet 1 (my master file). Then the macro will delete matched rows in sheet 2 and leave those unmatched. I have attached a test file Thanks
|
Highest Ranked Users
Recent Blogs
ForumsRecent comments
User login |
Put the following code in a
Put the following code in a general module and press F5 to run...
Sub Test()
Dim s1 As Range
Dim s2 As Range
Dim rngDel As Range
Dim rng1 As Range
Dim rng2 As Range
Set s1 = Sheet1.Range("E1").CurrentRegion
Set s2 = Sheet2.Range("D1").CurrentRegion
For Each rng1 In s1.Rows
For Each rng2 In s2.Rows
If rng1.Cells(, 1).Value = rng2.Cells(, 1).Value Then
If rngDel Is Nothing Then
Set rngDel = rng2.Cells(, 1)
Else
Set rngDel = Union(rngDel, rng2.Cells(, 1))
End If
End If
Next rng2
Next rng1
rngDel.EntireRow.Delete
End Sub
Matching Cells
Thanks a lot. The code works fine in the test file I gave you but it halts in the last line rngDel.EntireRow.Delete before the end sub at the end when I run it in my master file which has the same column layout as the test file.
Try this new code and change
Try this new code and change the sheet names as you have in your master file.
Sub Test()
Dim s1 As Range
Dim s2 As Range
Dim rngDel As Range
Dim rng1 As Range
Dim rng2 As Range
'Change Sheet1 and Sheet2 as per your sheets-----------------------------
Set s1 = ThisWorkbook.Worksheets("Sheet1").Range("E1").CurrentRegion
Set s2 = ThisWorkbook.Worksheets("Sheet2").Range("D1").CurrentRegion
'========================================================================
For Each rng1 In s1.Rows
For Each rng2 In s2.Rows
If rng1.Cells(, 1).Value = rng2.Cells(, 1).Value Then
If rngDel Is Nothing Then
Set rngDel = rng2.Cells(, 1)
Else
Set rngDel = Union(rngDel, rng2.Cells(, 1))
End If
End If
Next rng2
Next rng1
rngDel.EntireRow.Delete
End Sub