Run-time error '1004': Cannot run Visual Basic macro because of a syntax error

lemery

New Member
Joined
Jul 31, 2014
Messages
36
I have 280,000 rows with 36 columns. I'm looking to pair down the file. I would like to reduce the file so that there are no more than 10 rows per company (column H). Some companies have 3 rows, some have 5000. I would like the macro to return a sheet with up to, but no more than 10 rows per company along with all of columns associated with their row.

There are 5 sheets on my file. The sheet I'm trying to reduce is titled "All comp", the blank sheet where I want to the results to go titled "new data".
I am trying to use the below macro, but I'm getting the error: Run-time error '1004': Cannot run Visual Basic macro because of a syntax error

It highlights .calculate as the first step in what is wrong with what I've entered.
Code:
Sub TenDuplicates()


    With Application
        .ScreenUpdating = False
        .Calculate
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .EnableEvents = False
    End With








    Dim raw As Worksheet
    Dim output As Worksheet
    Dim names() As String
    
    Dim nextRow As Long
    Dim counter As Integer
    
    nextRow = 1
    counter = 0
    
    Set raw = Sheets("zebraUS")
    Set output = Sheets("New data")
    


    With output
        .UsedRange.Clear
        .Cells(1, 1).EntireColumn.Value = raw.Cells(1, 8).EntireColumn.Value
        .Range("H:H").RemoveDuplicates Columns:=1, Header:=xlNo


        For x = 1 To .Cells(Rows.Count, "H").End(xlUp).Row
            If x = 1 Then
                ReDim Preserve names(1 To 1)
            Else
                ReDim Preserve names(1 To x)
            End If
            
            names(x) = .Cells(x, 1)
        Next x
        
        .UsedRange.Clear
        
    End With
    
    With raw
        For x = 1 To UBound(names)
            counter = 0
            For y = 1 To .Cells(Rows.Count, "8").End(xlUp).Row
                If .Cells(y, 8) = names(x) Then
                    output.Cells(nextRow, 1).EntireRow.Value = _
                            .Cells(y, 1).EntireRow.Value
                    counter = counter + 1
                    nextRow = nextRow + 1
                End If
                
                Select Case counter
                    Case 10
                        GoTo nextName
                    Case Else
                End Select
                
            Next y
nextName:
        Next x
    End With




    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .EnableEvents = True
    End With

End Sub
 
Last edited by a moderator:

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
If you're going to post questions about my code, why not do it in the same thread? And if .calculate causes an error, you can just remove it. I didn't test the code before I ran it so the syntax for that is probably wrong. And if you're trying to get the data from "all comp", why is "ZebraUS" in your raw data tab name?

Also looking back at my code, this should be changed:

Code:
[COLOR=#333333]For x = 1 To .Cells(Rows.Count, [/COLOR][COLOR=#ff0000][B]"H"[/B][/COLOR][COLOR=#333333]).End(xlUp).Row[/COLOR]
[COLOR=#333333]If x = 1 Then[/COLOR]
[COLOR=#333333]ReDim Preserve names(1 To 1)[/COLOR]
[COLOR=#333333]Else[/COLOR]
[COLOR=#333333]ReDim Preserve names(1 To x)[/COLOR]
[COLOR=#333333]End If[/COLOR]

to "A".
 
Last edited:
Upvote 0
I tried responding back to the original thread several times and didn't hear back. I thought it would send an alert if I started a new one. I apologize if it came off as though I was stealing your code, that certainly wasn't my intention. I was the one who tweaked the H from A. I dis this for the part of the code that said A:A to H:H because I thought it was referencing the column that had the duplicates. Do I need to change H:H back to A:A? I made the updates you suggested and got the same error, when I click debug, it hightlights this line: For y = 1 To .Cells(Rows.Count, "8").End(xlUp).Row

I'm an avid Excel user, but I don't know anything about marcos so my skill level is nil so all the help you are giving me is greatly appreciated!
 
Upvote 0
I tried responding back to the original thread several times and didn't hear back. I thought it would send an alert if I started a new one. I apologize if it came off as though I was stealing your code, that certainly wasn't my intention. I was the one who tweaked the H from A. I dis this for the part of the code that said A:A to H:H because I thought it was referencing the column that had the duplicates. Do I need to change H:H back to A:A? I made the updates you suggested and got the same error, when I click debug, it hightlights this line: For y = 1 To .Cells(Rows.Count, "8").End(xlUp).Row

I'm an avid Excel user, but I don't know anything about marcos so my skill level is nil so all the help you are giving me is greatly appreciated!

I didn't think you were stealing the code. I guess I just missed the old thread in my morning check of updates. So I see now that the H:H and 8 are working. That part creates the array of names to loop through. As long as it's consistent, that's fine. The "8" shouldn't be in quotes. Either change that to "H" or remove the quotes around 8.
 
Upvote 0
It ran for a long time and then came back with a new error. the debugger highlighted the bolded area:




With raw
For x = 1 To UBound(names)
counter = 0
For y = 1 To .Cells(Rows.Count, 8).End(xlUp).Row
If .Cells(y, 8) = names(x) Then
output.Cells(nextRow, 1).EntireRow.Value = _
.Cells(y, 1).EntireRow.Value
counter = counter + 1
nextRow = nextRow + 1
End If

Select Case counter
Case 10
GoTo nextName
Case Else
End Select
 
Upvote 0
If you open up "New Data", how many rows are populated? And 15 minutes is a very long time, but like I said, my code is very iterative and not optimized.
 
Upvote 0
I went to the new data tab and no information was moved over. Here is the current code (incase I messed something up when tweaking the areas we previously discussed)
Sub TenDuplicates()


With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
.EnableEvents = False
End With








Dim raw As Worksheet
Dim output As Worksheet
Dim names() As String

Dim nextRow As Long
Dim counter As Integer

nextRow = 1
counter = 0

Set raw = Sheets("All comp")
Set output = Sheets("New data")



With output
.UsedRange.Clear
.Cells(1, 1).EntireColumn.Value = raw.Cells(1, 8).EntireColumn.Value
.Range("H:H").RemoveDuplicates Columns:=1, Header:=xlNo


For x = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
If x = 1 Then
ReDim Preserve names(1 To 1)
Else
ReDim Preserve names(1 To x)
End If

names(x) = .Cells(x, 1)
Next x

.UsedRange.Clear

End With

With raw
For x = 1 To UBound(names)
counter = 0
For y = 1 To .Cells(Rows.Count, 8).End(xlUp).Row
If .Cells(y, 8) = names(x) Then
output.Cells(nextRow, 1).EntireRow.Value = _
.Cells(y, 1).EntireRow.Value
counter = counter + 1
nextRow = nextRow + 1
End If

Select Case counter
Case 10
GoTo nextName
Case Else
End Select

Next y
nextName:
Next x
End With




With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.EnableEvents = True
End With








End Sub
 
Upvote 0
Code:
Sub TenDuplicates()



    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .EnableEvents = False
    End With


    Dim raw As Worksheet
    Dim output As Worksheet
    Dim names() As String
    
    Dim nextRow As Long
    Dim counter As Integer
    
    nextRow = 1
    counter = 0
    
    Set raw = Sheets("All comp")
    Set output = Sheets("New data")


    With output
        .UsedRange.Clear
        .Cells(1, 8).EntireColumn.Value = raw.Cells(1, 8).EntireColumn.Value
        .Range("H:H").RemoveDuplicates Columns:=1, Header:=xlNo
        
        For x = 1 To .Cells(Rows.Count, "H").End(xlUp).Row
            If x = 1 Then
                ReDim Preserve names(1 To 1)
            Else
                ReDim Preserve names(1 To x)
            End If
            names(x) = .Cells(x, 8)
        Next x
        .UsedRange.Clear
    
    End With


    With raw
        For x = 1 To UBound(names)
            counter = 0
            For y = 1 To .Cells(Rows.Count, 8).End(xlUp).Row
                If .Cells(y, 8) = names(x) Then
                    output.Cells(nextRow, 1).EntireRow.Value = _
                    .Cells(y, 1).EntireRow.Value
                    counter = counter + 1
                    nextRow = nextRow + 1
                End If
            
                Select Case counter
                    Case 10
                        GoTo nextName
                    Case Else
                End Select
            
            Next y
nextName:
        Next x
    End With




    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .EnableEvents = True
    End With


End Sub

Some slight modifications. My sample data that I have tested and verified looks like:


ABCDEFGH
111121314151617Company 1
221222324252627Company 1
331323334353637Company 1
441424344454647Company 1
551525354555657Company 1

<tbody>
</tbody>
 
Upvote 0

Forum statistics

Threads
1,213,522
Messages
6,114,112
Members
448,549
Latest member
brianhfield

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