Compile Error

Mr_Adams

Mr_Adams

Active Member
Joined
Oct 7, 2002
Messages
475
Im having trouble with this code. the code is for a userform, "Input_Form"
It involves taking data from the form and putting it in the next empty row of the activesheet. It also adds new entries to the proper sheet depending on what department is chosen. It also sorts these sheets and deletes duplictaes from them. I believe everything works properly except Im am recieving an error at the end
Compile Error:
Expected End With
End Sub is highlighted in the debugger
Code: 
' Puts information from the input form to next empty row of active sheet
Private Sub CommandButton2_Click()
    ActiveSheet.Range("A7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("A7:A200")), 0) = TextBox1.Value
    ActiveSheet.Range("B7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("B7:B200")), 0) = TextBox2.Value
    ActiveSheet.Range("C7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("C7:C200")), 0) = ComboBox1.Value
    ActiveSheet.Range("D7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("D7:D200")), 0) = ComboBox2.Value
    ActiveSheet.Range("E7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("E7:E200")), 0) = ComboBox3.Value
    ActiveSheet.Range("G7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("G7:G200")), 0) = TextBox5.Value
    ActiveSheet.Range("H7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("H7:H200")), 0) = TextBox7.Value
    ActiveSheet.Range("F7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("F7:F200")), 0) = TextBox6.Value
            
' deletes duplicates and sorts sheets - "Descriptions", "Descriptions2", "Descriptions3", "Departments", "Customers1", "Customers2"
        Dim ColA_uRng1, Cntr1
        Dim ColA_uRng2, Cntr2
        Dim ColA_uRng3, Cntr3
        Dim ColA_uRng4, Cntr4
        Dim ColA_uRng5, Cntr5
        Dim ColA_uRng6, Cntr6
For Cntr1 = 1 To Sheets("Description").UsedRange.Columns(1).Rows.Count
Set ColA_uRng1 = Sheets("Description").Range("A" & Cntr1 & ":A" & Sheets("Description").UsedRange.Columns(1).Rows.Count)
    If Application.WorksheetFunction.CountIf(ColA_uRng1, Sheets("Description").Range("A" & Cntr1).Value) > 1 Then
    Sheets("Description").Rows(Cntr1).Delete
    Cntr1 = Cntr1 - 1
    End If
For Cntr2 = 1 To Sheets("Description2").UsedRange.Columns(1).Rows.Count
Set ColA_uRng2 = Sheets("Description2").Range("A" & Cntr2 & ":A" & Sheets("Description2").UsedRange.Columns(1).Rows.Count)
    If Application.WorksheetFunction.CountIf(ColA_uRng2, Sheets("Description").Range("A" & Cntr2).Value) > 1 Then
    Sheets("Description").Rows(Cntr2).Delete
    Cntr2 = Cntr2 - 1
    End If
For Cntr3 = 1 To Sheets("Description3").UsedRange.Columns(1).Rows.Count
Set ColA_uRng3 = Sheets("Description3").Range("A" & Cntr3 & ":A" & Sheets("Description3").UsedRange.Columns(1).Rows.Count)
    If Application.WorksheetFunction.CountIf(ColA_uRng3, Sheets("Description").Range("A" & Cntr3).Value) > 1 Then
    Sheets("Description").Rows(Cntr3).Delete
    Cntr3 = Cntr3 - 1
    End If
For Cntr4 = 1 To Sheets("Departments").UsedRange.Columns(1).Rows.Count
Set ColA_uRng4 = Sheets("Departments").Range("A" & Cntr4 & ":A" & Sheets("Departments").UsedRange.Columns(1).Rows.Count)
    If Application.WorksheetFunction.CountIf(ColA_uRng4, Sheets("Description").Range("A" & Cntr4).Value) > 1 Then
    Sheets("Description").Rows(Cntr4).Delete
    Cntr4 = Cntr4 - 1
    End If
For Cntr5 = 1 To Sheets("Customer1").UsedRange.Columns(1).Rows.Count
Set ColA_uRng5 = Sheets("Customer1").Range("A" & Cntr5 & ":A" & Sheets("Customer1").UsedRange.Columns(1).Rows.Count)
    If Application.WorksheetFunction.CountIf(ColA_uRng5, Sheets("Description").Range("A" & Cntr5).Value) > 1 Then
    Sheets("Description").Rows(Cntr5).Delete
    Cntr5 = Cntr5 - 1
    End If
For Cntr6 = 1 To Sheets("Customer2").UsedRange.Columns(1).Rows.Count
Set ColA_uRng6 = Sheets("Customer2").Range("A" & Cntr6 & ":A" & Sheets("Customer2").UsedRange.Columns(1).Rows.Count)
    If Application.WorksheetFunction.CountIf(ColA_uRng6, Sheets("Description").Range("A" & Cntr6).Value) > 1 Then
    Sheets("Description").Rows(Cntr6).Delete
    Cntr6 = Cntr6 - 1
    End If
            Next
            With Sheets("Description")
                .[A1].Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
            With Sheets("Description2")
                .[A1].Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
            With Sheets("Description3")
                .[A1].Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
            With Sheets("Department")
                .[A1].Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
            With Sheets("Customer1")
                .[A1].Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
            With Sheets("Customer2")
                .[A1].Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
                End With
' Adds new customer and despription for selected department on appropriate sheet if not a duplicate
If ComboBox1.Value = "Coroner" Then
    [Customer1!A1].Offset(WorksheetFunction.CountA([Customer1!A1:A65536]), 0) = ComboBox2.Value
    [Description2!A1].Offset(WorksheetFunction.CountA([Description2!A1:A65536]), 0) = ComboBox3.Value
        ElseIf ComboBox1.Value = "Assessors" Then
            [Customer2!A1].Offset(WorksheetFunction.CountA([Customer2!A1:A65536]), 0) = ComboBox2.Value
            [Description!A1].Offset(WorksheetFunction.CountA([Description3!A1:A65536]), 0) = ComboBox3.Value
                Else: [Description!A1].Offset(WorksheetFunction.CountA([Description!A1:A65536]), 0) = ComboBox3.Value
                        [Departments!A1].Offset(WorksheetFunction.CountA([Departments!A1:A65536]), 0) = ComboBox2.Value
                        End If
' resets some fields and puts cursor back at the beginning
TextBox7.Value = vbNullString
TextBox1.Value = vbNullString
TextBox1.SetFocus
End Sub
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Sort by date Sort by votes
Thank you Juan
Fixing that brought up another problem to.
Each "For" has to have the "Next" following it, instead of all of them at the end.

I also had "Description" in this part of every "If" statement, instead of putting the corect sheet name in each statement.
If Application.WorksheetFunction.CountIf(ColA_uRng1, Sheets(" Description ").Range("A" & Cntr1).Value) > 1 Then
Sheets(" Description ").Rows(Cntr1).Delete


here is the final code
Code: 
' Puts information from the input form to next empty row of active sheet
Private Sub CommandButton2_Click()
    ActiveSheet.Range("A7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("A7:A200")), 0) = TextBox1.Value
    ActiveSheet.Range("B7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("B7:B200")), 0) = TextBox2.Value
    ActiveSheet.Range("C7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("C7:C200")), 0) = ComboBox1.Value
    ActiveSheet.Range("D7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("D7:D200")), 0) = ComboBox2.Value
    ActiveSheet.Range("E7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("E7:E200")), 0) = ComboBox3.Value
    ActiveSheet.Range("G7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("G7:G200")), 0) = TextBox5.Value
    ActiveSheet.Range("H7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("H7:H200")), 0) = TextBox7.Value
    ActiveSheet.Range("F7").Offset(WorksheetFunction.CountA(ActiveSheet.Range("F7:F200")), 0) = TextBox6.Value
            
' deletes duplicates and sorts sheets - "Description", "Description2", "Description3", "Departments", "Customers1", "Customers1"
        Dim ColA_uRng1, Cntr1
        Dim ColA_uRng2, Cntr2
        Dim ColA_uRng3, Cntr3
        Dim ColA_uRng4, Cntr4
        Dim ColA_uRng5, Cntr5
        Dim ColA_uRng6, Cntr6
For Cntr1 = 1 To Sheets("Description").UsedRange.Columns(1).Rows.Count
Set ColA_uRng1 = Sheets("Description").Range("A" & Cntr1 & ":A" & Sheets("Description").UsedRange.Columns(1).Rows.Count)
    If Application.WorksheetFunction.CountIf(ColA_uRng1, Sheets("Description").Range("A" & Cntr1).Value) > 1 Then
    Sheets("Description").Rows(Cntr1).Delete
    Cntr1 = Cntr1 - 1
    End If
        Next
        With Sheets("Description")
        .[A1].Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        End With
For Cntr2 = 1 To Sheets("Description2").UsedRange.Columns(1).Rows.Count
Set ColA_uRng2 = Sheets("Description2").Range("A" & Cntr2 & ":A" & Sheets("Description2").UsedRange.Columns(1).Rows.Count)
    If Application.WorksheetFunction.CountIf(ColA_uRng2, Sheets("Description2").Range("A" & Cntr2).Value) > 1 Then
    Sheets("Description2").Rows(Cntr2).Delete
    Cntr2 = Cntr2 - 1
    End If
        Next
        With Sheets("Description2")
        .[A1].Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        End With
For Cntr3 = 1 To Sheets("Description3").UsedRange.Columns(1).Rows.Count
Set ColA_uRng3 = Sheets("Description3").Range("A" & Cntr3 & ":A" & Sheets("Description3").UsedRange.Columns(1).Rows.Count)
    If Application.WorksheetFunction.CountIf(ColA_uRng3, Sheets("Description3").Range("A" & Cntr3).Value) > 1 Then
    Sheets("Description3").Rows(Cntr3).Delete
    Cntr3 = Cntr3 - 1
    End If
        Next
        With Sheets("Description3")
        .[A1].Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        End With
For Cntr4 = 1 To Sheets("Departments").UsedRange.Columns(1).Rows.Count
Set ColA_uRng4 = Sheets("Departments").Range("A" & Cntr4 & ":A" & Sheets("Departments").UsedRange.Columns(1).Rows.Count)
    If Application.WorksheetFunction.CountIf(ColA_uRng4, Sheets("Departments").Range("A" & Cntr4).Value) > 1 Then
    Sheets("Departments").Rows(Cntr4).Delete
    Cntr4 = Cntr4 - 1
    End If
        Next
        With Sheets("Departments")
        .[A1].Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        End With
For Cntr5 = 1 To Sheets("Customer1").UsedRange.Columns(1).Rows.Count
Set ColA_uRng5 = Sheets("Customer1").Range("A" & Cntr5 & ":A" & Sheets("Customer1").UsedRange.Columns(1).Rows.Count)
    If Application.WorksheetFunction.CountIf(ColA_uRng5, Sheets("Customer1").Range("A" & Cntr5).Value) > 1 Then
    Sheets("Customer1").Rows(Cntr5).Delete
    Cntr5 = Cntr5 - 1
    End If
        Next
        With Sheets("Customer1")
        .[A1].Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        End With
For Cntr6 = 1 To Sheets("Customer2").UsedRange.Columns(1).Rows.Count
Set ColA_uRng6 = Sheets("Customer2").Range("A" & Cntr6 & ":A" & Sheets("Customer2").UsedRange.Columns(1).Rows.Count)
    If Application.WorksheetFunction.CountIf(ColA_uRng6, Sheets("Customer2").Range("A" & Cntr6).Value) > 1 Then
    Sheets("Customer2").Rows(Cntr6).Delete
    Cntr6 = Cntr6 - 1
    End If
        Next
        With Sheets("Customer2")
        .[A1].Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        End With
' Adds new customer and despription for selected department on appropriate sheet if not a duplicate
If ComboBox1.Value = "Coroner" Then
    [Customer1!A1].Offset(WorksheetFunction.CountA([Customer1!A1:A65536]), 0) = ComboBox2.Value
    [Description2!A1].Offset(WorksheetFunction.CountA([Description2!A1:A65536]), 0) = ComboBox3.Value
        ElseIf ComboBox1.Value = "Assessors" Then
            [Customer2!A1].Offset(WorksheetFunction.CountA([Customer2!A1:A65536]), 0) = ComboBox2.Value
            [Description!A1].Offset(WorksheetFunction.CountA([Description3!A1:A65536]), 0) = ComboBox3.Value
                Else: [Description!A1].Offset(WorksheetFunction.CountA([Description!A1:A65536]), 0) = ComboBox3.Value
                        [Departments!A1].Offset(WorksheetFunction.CountA([Departments!A1:A65536]), 0) = ComboBox2.Value
                        End If
' resets some fields and puts cursor back at the beginning
TextBox7.Value = vbNullString
TextBox1.Value = vbNullString
TextBox1.SetFocus
End Sub

Thanks Again Juan
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Keep getting an "Error 1004: item could not be found in the OLAP cube" when applying the filter to pivot table
Replies
5
Views
979
RoryA
RoryA
willow1985
  • Solved
VBA Compile error - Trying to send an email using VBA/Excel
Replies
6
Views
596
gorgkhan
G
C
  • Solved
error codes when compiling
Replies
3
Views
631
CrashOD
C
P
  • Question
VBA for sending rows of data if column A = current date. (Via email)
Replies
1
Views
438
paun_shotts
P
M
  • Solved
VBA Compile error - Object required but everything looks right ...
Replies
3
Views
1K
MichaelDeShazo1606
M

Forum statistics

Threads
1,215,766
Messages
6,126,763
Members
449,336
Latest member
p17tootie

Share this page

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