Code to cut and paste has all of a sudden stopped working.

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,748
Office Version
  1. 365
Platform
  1. 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

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
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Any thoughts anyone please? I am sure you experts can read a code like I do the sports pages!!
 
Upvote 0
Things missing are the decaration for the variables below:=
Code:
    Dim lastcol As Long
    Dim cell    As Range
    Dim r       As Long

The code worked for me on some test data, That "Error" line refers to sheet1, row 1 and the number of the last column with data
I've not been able to make the CODE "Error".
 
Upvote 0
I would guess that there's a routine called LastCol somewhere and, without the variable declaration that Mick mentioned, the compiler assumes you're trying to call it.
 
Upvote 0
I add those lines of code and there was no error, but it did not work correctly. I think was is happening is it finds a number that is in column A in column AC on sheet 1, but removes the wrong line because I think it finds the number then when it removes the row and closes the gap it remembers the original row number but it has moved so it takes out the wrong row. I hope this makes sense!
 
Upvote 0
I'd be intrigued to know where this code came from - I haven't seen anyone use GoSub in a long time.
 
Upvote 0
Would a new code be able to be written please. It is such an important code to me and I use it alot, I just don't know what happened with this code.
 
Upvote 0
We'd need more information as to exactly what is going wrong with it currently. If the code hasn't changed, then there must be something about your data for it to behave differently.
 
Upvote 0
There are parts of the code missing and I don't know how or why that has happened. As in my first post I have highlighted where it is failing. If it has to be written from scratch I can explain exactly what it needs to do.
 
Upvote 0
There are parts of the code missing and I don't know how or why that has happened.
Do you not have a backup copy?

As in my first post I have highlighted where it is failing. If it has to be written from scratch I can explain exactly what it needs to do.

No, you haven't - the error in the first post was fixed and is unrelated to this new issue.

If parts of your code are missing, I wouldn't really expect it to work at all, so I'm not sure I understand what you're getting at, I'm afraid. Please tell us specifically what is happening that should not, or what isn't happening, that should.
 
Upvote 0

Forum statistics

Threads
1,215,236
Messages
6,123,799
Members
449,127
Latest member
Cyko

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top