Code does not run when assigned to a button

tswood · Sep 29th 2016

I have created code that works perfectly when I select 'run' from the vba screen, however when I assign this code to a button it fails to run in the same way and encounters errors.

The code I am using is as follows:

Code

Option Compare Text




Sub Create_Security_List_v3()




Set wsSource = Worksheets("Registration")
Set wsTarget = Worksheets("Presenter List")
Set wsPart = Worksheets("Participant List")




Dim lastRow As Long




Application.ScreenUpdating = False




Range("A12:E111").ClearContents




wsSource.Activate




Application.ScreenUpdating = False




Dim r As Range
Set r = wsSource.Cells(2, 6)




r.Select
wsSource.Sort.SortFields.Clear
wsSource.Sort.SortFields.Add Key:=r, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal




With wsSource.Sort
    .SetRange Range("A2", Range("A2").End(xlDown).End(xlToRight))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With




wsSource.Range("A2") = 1
wsSource.Range("A2").Select
Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Stop:=Cells(Rows.Count, "A").End(xlUp).Row - 1, Trend:=False




For i = 1 To Cells(Rows.Count, "C").End(xlUp).Row
If InStr(1, wsSource.Cells(i, 3).Value, "Complete") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




ElseIf InStr(1, wsSource.Cells(i, 3).Value, "Tentative") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




End If




Next i




wsTarget.Activate




    Application.Goto Reference:="R12C1"
    Selection.End(xlDown).Select
    
    Dim maxRowIndex As Integer
    '-4 to account for the header row. Remove or adjust at will
    maxRowIndex = ActiveCell.Row - 11
    
    Range("A12").Select
    Dim rowCounter As Integer
    rowCounter = 1
    
    For rowCounter = 1 To maxRowIndex
        'populate number in sequence
        ActiveCell = rowCounter
        'go to next row
        ActiveCell.Offset(1).Select
    Next




Dim lRow As Integer




With wsPart
lRow = wsTarget.Range("A5").CurrentRegion.Rows.Count
.Range("A5:F9").Copy wsTarget.Range("A5")
End With




Rows(8).RowHeight = 10.5




Dim rngBlnk As Range




On Error Resume Next
Set rngBlnk = Range("A5:A7").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0




If Not rngBlnk Is Nothing Then
rngBlnk.EntireRow.Hidden = True
End If




Application.ScreenUpdating = True




End Sub

Display More

Is there a reason why this may be occurring?

Thanks

cytop · Sep 29th 2016

Re: Code does not 'run' when assigned to a button

Quote

Is there a reason why this may be occurring?

Obviously there is, but there's not enough information in your post to say why.

Quote

it fails to run in the same way and encounters errors

You should expend that statement - what does it do, or not do, depending how you start it? What errors occur? (Probably 1004, though - but that's just as unhelpful).

What type of button is it? ActiveX or Forms?
What type of module contains the code? (Standard code module/Class module/worksheet class/userform)...?

tswood · Oct 3rd 2016

Re: Code does not 'run' when assigned to a button

Okay, thank-you. Let me try that again.

I created code that executes correctly when I select Run from the VBA screen. The code is within a Standard Code Module (see below).

Code

Option Compare Text




Sub Create_Security_List_v3()




Set wsSource = Worksheets("Registration")
Set wsTarget = Worksheets("Security List")
Set wsPart = Worksheets("Participant List")




Dim lastRow As Long




Application.ScreenUpdating = False




'Clear cells for the purpose of re-submitting security list




Range("A12:E111").ClearContents




wsSource.Activate




'Sort registration names alphabetically




Application.ScreenUpdating = False




Dim r As Range
Set r = wsSource.Cells(2, 6)




r.Select
wsSource.Sort.SortFields.Clear
wsSource.Sort.SortFields.Add Key:=r, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal




With wsSource.Sort
    .SetRange Range("A2", Range("A2").End(xlDown).End(xlToRight))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With




'Sequential numbering for Registration Sheet




wsSource.Range("A2") = 1
wsSource.Range("A2").Select
Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Stop:=Cells(Rows.Count, "A").End(xlUp).Row - 1, Trend:=False




'Move judicial officers to Security List by checking 'Position'




For i = 1 To Cells(Rows.Count, "C").End(xlUp).Row
If InStr(1, wsSource.Cells(i, 3).Value, "Magistrate") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




ElseIf InStr(1, wsSource.Cells(i, 3).Value, "Judge") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




ElseIf InStr(1, wsSource.Cells(i, 3).Value, "Justice") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




ElseIf InStr(1, wsSource.Cells(i, 3).Value, "Coroner") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




ElseIf InStr(1, wsSource.Cells(i, 3).Value, "Registrar") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




ElseIf InStr(1, wsSource.Cells(i, 3).Value, "Member") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




ElseIf InStr(1, wsSource.Cells(i, 3).Value, "President") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




End If




Next i




wsTarget.Activate




'Sequential numbering




    'r = row, c = column
    Application.Goto Reference:="R12C1"
    Selection.End(xlDown).Select
    
    Dim maxRowIndex As Integer
    '-4 to account for the header row. Remove or adjust at will
    maxRowIndex = ActiveCell.Row - 11
    
    'set up starting point of repetition structure
    Range("A12").Select
    Dim rowCounter As Integer
    rowCounter = 1
    
    'begin populating sequence
    For rowCounter = 1 To maxRowIndex
        'populate number in sequence
        ActiveCell = rowCounter
        'go to next row
        ActiveCell.Offset(1).Select
    Next




'Copy program title




Dim lRow As Integer




With wsPart
lRow = wsTarget.Range("A5").CurrentRegion.Rows.Count
.Range("A5:F9").Copy wsTarget.Range("A5")
End With




'Changing the height of the empty rows




Rows(8).RowHeight = 10.5




'Hide blank 'program title' rows




Dim rngBlnk As Range




On Error Resume Next
Set rngBlnk = Range("A5:A7").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0




If Not rngBlnk Is Nothing Then
rngBlnk.EntireRow.Hidden = True
End If




Application.ScreenUpdating = True




End Sub

Display More

I then assigned the code to Button (Form Control) which has caused the code to run incorrectly.

The first issue is to do with the part of the code that finds a match on wsSource and then copies the columns to wsTarget.

When I select Run in the VBA screen this occurs (which is correct)

[ATTACH=CONFIG]70346[/ATTACH]

When I select the Button the following occurs (which is incorrect):

[ATTACH=CONFIG]70347[/ATTACH]

The second issue is that when I select the Button I encounter the following error:

Run-time error '6': Overflow

When I select Debug I can see that the part of the code that is causing this error is as follows:

Code

maxRowIndex = ActiveCell.Row - 11

Any assistance would be greatly appreciated.

Thank-you

cytop · Oct 4th 2016

Re: Code does not 'run' when assigned to a button

Starting at the simplest... The Error 6 is a result of an invalid assignment to a particular data type. It is such a fundamental concept in any programming language that you need to understand it yourself to avoid it in future. You could start by reading this (That page is from an Access book but the concept is the same for Excel - it's all VBA).

The remaining issues are not program errors as such but logic errors - it is not doing as you expect. The only pointer I can give here is that there are some references to ranges that are not qualified with a sheet name - it is possible the incorrect sheet is being updated.

Without a copy of the workbook I can't be any more exact, a quick read of the code doesn't show any glaring issues, so this is one for you to try debugging.

Debugging is an essential part of any development, you can step through the code line by line testing the values of variables before a line executes to confirm it is working with the right values, you can change the value stored in a variable or even change which like will execute next (within limits). For a good basic primer on debugging, see this page.

Code does not run when assigned to a button

Participate now!

Share