My Never ending ARRAY code problems
Hi Howard,
Am Wed, 11 Feb 2015 17:00:22 -0800 (PST) schrieb L. Howard:
Want to compare sheet1 column C list to sheet2 column H list and if match copy column H row A to Z to Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp)(2).
you also could copy the range A2:Z & Lrow to sheet3 and delete the rows
that do not match:
Sub ColumnsCompare2()
Dim i As Long, n As Long
Dim LRow1 As Long, LRow2 As Long
Dim MyArr As Variant
LRow1 = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
LRow2 = Sheets("Sheet2").Cells(Rows.Count, "H").End(xlUp).Row
MyArr = Sheets("Sheet2").Range("H2:H" & LRow2)
Application.ScreenUpdating = False
Sheets("Sheet2").Range("A2:Z" & LRow2).Copy
Sheets("Sheet3").Range("A1").PasteSpecial xlPasteValues
With WorksheetFunction
For i = LBound(MyArr) To UBound(MyArr)
If .CountIf(Sheets("Sheet1").Range("C:C"), MyArr(i, 1)) 0 Then
GoTo myNext
Else
n = .Match(MyArr(i, 1), Sheets("Sheet3").Range("H1:H" & LRow2), 0)
End If
Sheets("Sheet3").Rows(n).Delete
myNext: Next
End With
Application.ScreenUpdating = True
End Sub
Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional
|