Hi all,
I have code compare rows Result sheet & DLV030 sheet then delete row not matching but problem if at A2 (Result sheet) have only 1row, it will error at. Can help me fix this error. Thank all
I have code compare rows Result sheet & DLV030 sheet then delete row not matching but problem if at A2 (Result sheet) have only 1row, it will error at. Can help me fix this error. Thank all
d(itm) = 1
Sub save_as_file()
Dim d As Object
Dim a As Variant, b As Variant, itm As Variant
Dim nc As Long, i As Long, k As Long
Dim lastrow As Long
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Application.DisplayAlerts = False
Sheet1.Activate
Set d = CreateObject("Scripting.Dictionary")
a = Sheets("Result").Range("A2", Sheets("Result").Range("A" & Rows.Count).End(xlUp)).Value
For Each itm In a
d(itm) = 1
Next itm
With Sheets("DLV030")
a = .Range("AU2", .Range("AU" & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
If Not d.exists(a(i, 1)) Then
k = k + 1
b(i, 1) = 1
End If
Next i
If k > 0 Then
Application.ScreenUpdating = False
nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
With .Range("A2").Resize(UBound(a), nc)
.Columns(nc).Value = b
.Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
.Resize(k).EntireRow.Delete
End With
Application.ScreenUpdating = True
End If
End With
ActiveSheet.Cells(Rows.Count, "D").End(xlUp).EntireRow.Delete
End Sub