Unable to call subroutine

cklim01

New Member
Joined
Nov 18, 2015
Messages
5
My code was unable to call BCD when user input valid txtWeekNo in userform. If txtWeekNo is invalid or empty, it will execute sub BCD. Below is my code and can i know what's wrong with my code? Thanks

Code:
Option Explicit
Dim LColumn As Integer, Acolumn As Integer, i As Integer, LRow As Integer, a As Integer, b As Integer, AA As Integer, BB As Integer, ValidWeekNo As Integer
Dim WeekNoRng As Range, OpenWORng As Range


Private Sub cmdOK1_Click()


Call ABC
Call BCD


End Sub


Sub ABC()


'Prompt message box when week number is empty
    If Me.txtWeekNo.Value = "" Then
        MsgBox "Please enter week number to print.", vbExclamation, "Print Work Order by Schedule"
        Me.txtWeekNo.SetFocus
        Exit Sub
    End If
    
'Check for valid week number
LColumn = Worksheets("RIG PMS").Cells(5, Worksheets("RIG PMS").Columns.Count).End(xlToLeft).Column 'Define last column in week number
Set WeekNoRng = Worksheets("RIG PMS").Range(Cells(5, 10), Cells(5, LColumn))
    If WorksheetFunction.CountIf(WeekNoRng, txtWeekNo.Value) = 0 Then
         MsgBox "Invalid Week Number"
         Exit Sub
        Else
            Unload UserForm1
    End If


    'Determine Column
        For i = 10 To LColumn
            If WorksheetFunction.CountIf(Worksheets("RIG PMS").Cells(5, i), txtWeekNo.Value) > 0 Then
                Acolumn = i
            End If
        Next i
     
LRow = Worksheets("RIG PMS").Cells(Rows.Count, "I").End(xlUp).Row
Set OpenWORng = Worksheets("Open WO").Range("B3:B" & Worksheets("Open WO").Range("B" & Rows.Count).End(xlUp).Row)


    For a = 7 To LRow Step 3
        AA = 0
        If Worksheets("RIG PMS").Cells(a, Acolumn).Value <> "" And Worksheets("RIG PMS").Cells(a, Acolumn - 2).Value = 1 Then
            b = Worksheets("RIG PMS").Cells(a, 7).Value
            Worksheets("Power Pack Monthly").Range("C5").Value = Worksheets("RIG PMS").Cells(a - b, 2).Value 'Asset Code
            Worksheets("Power Pack Monthly").Range("C6").Value = Worksheets("RIG PMS").Cells(a - b, 3).Value 'Description
            Worksheets("Power Pack Monthly").Range("P5").Value = Worksheets("RIG PMS").Cells(a, Acolumn).Value 'WO
            Worksheets("Power Pack Monthly").Range("P6").Value = Worksheets("RIG PMS").Cells(a + 1, Acolumn).Value 'Proposed Date
            AA = 1
        End If
        
        If Worksheets("RIG PMS").Cells(a, Acolumn).Value <> "" And Worksheets("RIG PMS").Cells(a, Acolumn - 2).Value = 2 Then
            b = Worksheets("RIG PMS").Cells(a, 7).Value
            Worksheets("Power Pack 6 Monthly").Range("C5").Value = Worksheets("RIG PMS").Cells(a - b, 2).Value 'Asset Code
            Worksheets("Power Pack 6 Monthly").Range("C6").Value = Worksheets("RIG PMS").Cells(a - b, 3).Value 'Description
            Worksheets("Power Pack 6 Monthly").Range("P5").Value = Worksheets("RIG PMS").Cells(a, Acolumn).Value 'WO
            Worksheets("Power Pack 6 Monthly").Range("P6").Value = Worksheets("RIG PMS").Cells(a + 1, Acolumn).Value 'Proposed Date
            AA = 1
        End If
        
    'Copy Open WO to Open WO Sheet
         If WorksheetFunction.CountIf(OpenWORng, Worksheets("RIG PMS").Cells(a, Acolumn).Value) = 0 And AA = 1 Then
            Worksheets("Open WO").Range("B" & Worksheets("Open WO").Range("B" & Rows.Count).End(xlUp).Row + 1).Value = Worksheets("RIG PMS").Cells(a, Acolumn).Value 'WO No.
            Worksheets("Open WO").Range("C" & Worksheets("Open WO").Range("C" & Rows.Count).End(xlUp).Row + 1).Value = Worksheets("RIG PMS").Cells(a - b, 2).Value 'Asset Code
            Worksheets("Open WO").Range("D" & Worksheets("Open WO").Range("D" & Rows.Count).End(xlUp).Row + 1).Value = Worksheets("RIG PMS").Cells(a - b, 3).Value 'Asset Description
            Worksheets("Open WO").Range("E" & Worksheets("Open WO").Range("D" & Rows.Count).End(xlUp).Row).Value = 1 'For trigger purpose
        End If
        
        If a = LRow - 2 Then
            MsgBox "Continue"
            Exit Sub
        End If
    Next a


End Sub


Sub BCD()


   MsgBox "ABC"


End Sub
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
at a guess I would suggest it errors out somewhere and exits the sub routine
 
Upvote 0
Mole999, no error prompt out when run. Sub ABC work as per expected. Msgbox "Continue" pop up as well. But Sub BCD was unable to execute
 
Upvote 0
did you step through with F8, though I can't see why it won't run as you completed ABC to bottom. the CALL is not necessary, you can just do
Code:
sub
ABC
BCD
end sub
 
Upvote 0
I tried F8 and it will go thru ABC until msgbox pop up then go back to main sub highlight BCD and direct go to end sub instead of execute BCD.
I tried to remove "Call" but it make no different.
 
Upvote 0

Forum statistics

Threads
1,216,551
Messages
6,131,310
Members
449,642
Latest member
jobon

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