Procedure too large

[sdoppke]

HI everyone, I am getting a procedure too large error. I realize the macro is too large. I did not use the recorder (after searching the forum, realize that the recorder can cause procedure to be quite large) the script is posted below (removed some of the repetetive code) Would anyone have any input on how to reduce this?

Thank you very much in advance for any help.

Option Explicit
Sub CheckBox_ClickEvent(Target, iNameRow As Long, iO As Long, iRowToHide As Long, c As Long, b As String)
    Dim wsST1                   As Worksheet
    Dim wsMSI                   As Worksheet
    Dim wks                     As Worksheet
    Dim FindValue               As Variant
    Dim Box                     As Variant
    Dim rFind                   As Range
    Dim iRowNum                 As Long
    Dim iColNum                 As Long
    Dim putName                 As String
    Dim i                       As Long
    Dim RowNum                  As Integer
    Dim colnum                  As Integer
    Dim cFound                  As Range
    Dim rFound                  As Range
    
    If Target.Value >= 0 Then
    
        Set wsST1 = ThisWorkbook.Sheets("Schedule Tool1")
        Set wsMSI = ThisWorkbook.Sheets("MyStoreInfo")
        
        If WorksheetFunction.Count(wsST1.Range("D" & iO & ":BR" & iO)) = 0 Then
        
        Application.ScreenUpdating = False
        FindValue = wsST1.Range("A" & c).Value
        Box = b
        On Error GoTo finish
        Set rFind = wsMSI.Range("P10:AD156").Find(What:=FindValue, LookIn:=xlValues, LookAt:=xlWhole)
        On Error GoTo 0
        iRowNum = rFind.Row
        iColNum = rFind.Column
        putName = wsMSI.Range("B" & iNameRow) & " " & wsMSI.Range("C" & iNameRow)
        
        Sheets("Settings").Visible = True
                Sheets("Settings").Select
                'On Error GoTo finish
                Set cFound = Sheets("Settings").Range("C63:AK63").Find(What:=rFind, LookIn:=xlValues, LookAt:=xlWhole)
                Set rFound = Sheets("Settings").Range("A64:A120").Find(What:=putName, LookIn:=xlValues, LookAt:=xlWhole)
                Sheets("Settings").Visible = True
                RowNum = rFound.Row
                colnum = cFound.Column
                Sheets("Settings").Cells(RowNum, colnum) = Box
                Sheets("Settings").Visible = False
                wsMSI.Visible = False
                
        For i = 1 To 32
        
            If wsMSI.Cells(iRowNum + i, iColNum).Value = "" Or wsMSI.Cells(iRowNum + i, iColNum).Value = putName Then
                wsMSI.Cells(iRowNum + i, iColNum).Value = putName
                wsMSI.Cells(iRowNum + i, iColNum + 1).Value = Box
                wsST1.Rows(iRowToHide).Hidden = True
                Exit Sub
                
            ElseIf wsMSI.Cells(iRowNum + i, iColNum + 1).Value = putName Then
            Else
                If i = 32 Then
                    MsgBox ("No more room to schedule anyone off that day.")
                    wsMSI.Visible = False
                    Application.EnableEvents = False
                    Target.Value = ""
                    Application.EnableEvents = True
                    Application.ScreenUpdating = True
                    Exit Sub
                End If
            End If
        Next
    
        Else
            MsgBox ("You must clear the blocks of time in this row in order to schedule time off for this individual")
        End If
        Exit Sub
finish:
        
        
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Here
If Target.Address = "$B$5" And Target.Value = "o" Or Target.Value = "O" Then
Call CheckBox_ClickEvent(Target, 10, 5, 5, 4, "O")
End If
If Target.Address = "$B$5" And Target.Value = "p" Or Target.Value = "P" Then
Call CheckBox_ClickEvent(Target, 10, 5, 5, 4, "P")
End If
If Target.Address = "$B$6" And Target.Value = "o" Or Target.Value = "O" Then
Call CheckBox_ClickEvent(Target, 11, 6, 6, 4, "O")
End If
If Target.Address = "$B$6" And Target.Value = "p" Or Target.Value = "P" Then
Call CheckBox_ClickEvent(Target, 11, 6, 6, 4, "P")
End If
If Target.Address = "$B$7" And Target.Value = "o" Or Target.Value = "O" Then
Call CheckBox_ClickEvent(Target, 12, 7, 7, 4, "O")
End If
If Target.Address = "$B$7" And Target.Value = "p" Or Target.Value = "P" Then
Call CheckBox_ClickEvent(Target, 12, 7, 7, 4, "P")
End If

'This goes on and on and on....

 

[Andrew Poulsom]

I think this:

    If Target.Address = "$B$5" And Target.Value = "o" Or Target.Value = "O" Then
        Call CheckBox_ClickEvent(Target, 10, 5, 5, 4, "O")
    End If
    If Target.Address = "$B$5" And Target.Value = "p" Or Target.Value = "P" Then
        Call CheckBox_ClickEvent(Target, 10, 5, 5, 4, "P")
    End If

could be rewritten:

    If Target.Address = "$B$5" And (UCase(Target.Value) = "O" Or UCase(Target.Value) = "P") Then
        Call CheckBox_ClickEvent(Target, 10, 5, 5, 4, UCase(Target.Value))
    End If

 

[Jonmo1]

If this is the repetitive part, and you've given a fair sample of the pattern...

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Here
If Target.Address = "$B$5" And Target.Value = "o" Or Target.Value = "O" Then
Call CheckBox_ClickEvent(Target, 10, 5, 5, 4, "O")
End If
If Target.Address = "$B$5" And Target.Value = "p" Or Target.Value = "P" Then
Call CheckBox_ClickEvent(Target, 10, 5, 5, 4, "P")
End If
If Target.Address = "$B$6" And Target.Value = "o" Or Target.Value = "O" Then
Call CheckBox_ClickEvent(Target, 11, 6, 6, 4, "O")
End If
If Target.Address = "$B$6" And Target.Value = "p" Or Target.Value = "P" Then
Call CheckBox_ClickEvent(Target, 11, 6, 6, 4, "P")
End If
If Target.Address = "$B$7" And Target.Value = "o" Or Target.Value = "O" Then
Call CheckBox_ClickEvent(Target, 12, 7, 7, 4, "O")
End If
If Target.Address = "$B$7" And Target.Value = "p" Or Target.Value = "P" Then
Call CheckBox_ClickEvent(Target, 12, 7, 7, 4, "P")
End If

That can be replaced with

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Here

If Not Intersect(Target, Range("B5:B7")) Is Nothing Then
    If Ucase(Target.Value) = "O" or Ucase(Target.Value) = "P" Then
        Call CheckBox_ClickEvent(Target, Target.Row + 5, Target.Row, Target.Row, 4, Ucase(Target.Value))
    End If
End If
End Sub

 

[p45cal]

try along these lines:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Here
If Not Intersect(Target, Range("B5:B[COLOR=#0000ff][B]7[/B][/COLOR]")) Is Nothing And Target.Cells.Count = 1 Then    'adjust the range on this line
    Select Case UCase(Target.Value)
        Case "O", "P"
            Call CheckBox_ClickEvent(Target, Target.Row + 5, Target.Row, Target.Row, 4, UCase(Target.Value))
    End Select
End If
...