Dazzawm
Well-known Member
- Joined
- Jan 24, 2011
- Messages
- 3,751
- Office Version
- 365
- Platform
- Windows
I have been using the code below that looks at column A on sheet2 at the numbers and when they are found on sheet 1 in column AC the entire row is cut and pasted to sheet 3. All of a sudden it has stopped working and sorry i cant find the original thread. Would anyone have any idea why it has stopped please.
I have highlighted where it is failing. The error says compile error - argument not optional
I have highlighted where it is failing. The error says compile error - argument not optional
Rich (BB code):
Dim Cnt As Long
Dim CmpRng As Range
Dim Data As Variant
Dim DataOut As Variant
Dim DstRng As Range
Dim Dict As Object
Dim Item As Variant
Dim Key As String
Dim Rng As Range
Dim RngEnd As Range
Dim Row As Range
Set CmpRng = Worksheets("Sheet1").Range("AC2")
Set Rng = Worksheets("Sheet2").Range("A2")
Set DstRng = Worksheets("Sheet3").Range("A2")
Set Data = CmpRng: GoSub SizeRange: Set CmpRng = Data
Set Data = Rng: GoSub SizeRange: Set Rng = Data
LastCol = CmpRng.Parent.Cells(1, Columns.Count).End(xlToLeft).Column
' Find the next empty row on Sheet3.
Set DstRng = DstRng.Resize(1, LastCol)
Set RngEnd = DstRng.Parent.Cells(Rows.Count, "C").End(xlUp)
Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, -2).Resize(1, LastCol))
' Copy the list on Sheet2 into the Dictionary to allow random access.
Set Dict = CreateObject("Scripting.Dictionary")
Dict.CompareMode = vbTextCompare
For Each Cell In Rng
Key = Trim(Cell)
If Key <> "" Then
If Not Dict.Exists(Key) Then Dict.Add Key, 1
End If
Next Cell
' Copy Sheet1's values into an array to speed up comparisons.
ReDim DataOut(0)
Data = CmpRng.Value
' Compare Sheet1 values to Sheet2 and copy to the array DataOut.
For r = 2 To UBound(Data)
Key = Trim(Data(r, 1))
If Dict.Exists(Key) Then
ReDim Preserve DataOut(Cnt)
Set Row = CmpRng.Parent.Rows(r).Resize(1, LastCol)
DataOut(Cnt) = Row.Value
Row.Value = Empty
Cnt = Cnt + 1
End If
Next r
' Copy DataOut values to Sheet3.
For r = 0 To Cnt - 1
DstRng.Offset(r, 0).Value = DataOut(r)
Next r
' Sort Sheet1 to remove the blank rows.
With CmpRng.Parent.Sort
.SortFields.Clear
.SortFields.Add Key:=CmpRng.Parent.Columns("C").Cells, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=CmpRng.Parent.Columns("A").Cells, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SetRange CmpRng.Parent.UsedRange
.SortMethod = xlPinYin
.Apply
End With
Exit Sub
SizeRange:
' Find the end of range.
Set RngEnd = Data.Parent.Cells(Rows.Count, Data.Column).End(xlUp)
If RngEnd.Row < Data.Row Then
MsgBox "Worksheet Contains No Data!", vbExclamation
Exit Sub
Else
Set Data = Data.Parent.Range(Data, RngEnd)
End If
Return
End Sub