Object Required Error With A Userform

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
4,564
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I seem to be stuck with a problem that likely has a very simple solution ...

My Code ...

Rich (BB code):
        'update userform
        With uf1_main
        'active
            With .lb_cntaba_dt
                .Caption = cnt_dt
                If cnt_dt = 0 Then
                    .Enabled = False
                    .lb_aba_dt.Enabled = False
                End If
            End With
            ...

uf1_main is a userform and and I'm trying to update it's objects. I am getting an "object required" error with the line in red which I assume means the actual userform isn't being recognized.
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Maybe not so simple?

Two workbooks "Rental_Detail.xlsm"(wb1) and "WATSOP19.xlsm" (wb2).
wb1 hosts userform "group_1", and wb2 hosts userform "uf1_main"
Both userforms are open.
This code resides in a module found in wb1 and is intended to update userform uf1_main controls in wb2.

Does this help?
 
Upvote 0
Hi Ark68,

Is the form opened or is this code in a standard module? It would seem to me that the code should reside in the uf1_main form's Activate property??

If you're running it from a standard module you'd use something like this:

Code:
Option Explicit
Sub Macro1()

    Dim frmMyForm As UserForm
    
    Set frmMyForm = UserForm1
    
    With frmMyForm.lb_cntaba_dt
        .Caption = cnt_dt
        If cnt_dt = 0 Then
            .Enabled = False
            .lb_aba_dt.Enabled = False
        End If
    End With
    
    Set frmMyForm = Nothing
    
End Sub

HTH

Robert
 
Upvote 0
Hi Robert,

I'm very much a novice at this, so excuse my ignorance if I'm not understanding, or I'm trying to do something that can't be done with my approach.

The form that I am trying to update is "open" The code is in a standard module in wb2 and is triggered by an object click in userform "group_1"

In the grand scheme of things, uf1_main is the main interface for the user. When an instance of missing information is encountered in userform uf1_main, group_1 is opened allowing the user to resolve that information. Once the user had entered the information in group_1 userform, pressing a "SUBMIT" button processes that information. The code that I'm unable to get to work is intended to update the information in uf1_main that was previously missing before the user reconciled the missing date with userform group_1. (ie update uf1_main). Once the uf1_main has been "updated" group_1 may or may not close based on certain circumstances.

Needless to say, your solution did not work. I am still receiving an "Object required" error with
Code:
With uf1_main.lb_cntaba_dt
:(
 
Upvote 0
Based on Andrew Poulsom's post from this thread the following code in the Rental_Detail.xlsm workbook should do what you're after:

Code:
Option Explicit
Sub Macro1()

    'The following has been adapted from Andrew Poulsom's code found here: _
    https://www.mrexcel.com/forum/excel-questions/78426-reference-object-user-form-separate-workbook.html
    'Note the macro setting 'Trust access to the VBA project object model' on _
    the workbook that contains the form you want to update has to be ticked (selected).
    
    Dim cnt_dt
    Dim VBC As Object ' UserForm VBComponent
        
    cnt_dt = 12345 'This is just for testing
    
    Set VBC = Workbooks("WATSOP19.xlsm").VBProject.VBComponents("uf1_main")
    VBC.Designer.Controls("lb_cntaba_dt").Caption = cnt_dt
    
End Sub

Note you will have to tick the "Trust access to the VBA project object model" on the WATSOP19.xlsm workbook for the above code to work.

Regards,

Robert
 
Upvote 0
Hello Robert, thanks for finding this for on my behalf.
I've replaced my previous code with this suggestion ...

Rich (BB code):
        Dim VBC As Object ' UserForm VBComponent

        Set VBC = Workbooks("WATSOP19.xlsm").VBProject.VBComponents("uf1_main")
        'update userform
       
        'active
        VBC.Designer.Controls("lb_cntaba_dt").Caption = cnt_dt
            If cnt_dt = 0 Then
                VBC.Designer.Controls("lb_cntaba_dt").Enabled = False
                VBC.Designer.Controls("lb_aba_dt").Enabled = False
            End If
        VBC.Designer.Controls("lb_cntaba_dr").Caption = cnt_dr
            If cnt_dr = 0 Then
                VBC.Designer.Controls("lb_cntaba_dr").Enabled = False
                VBC.Designer.Controls("lb_aba_dr").Enabled = False
            End If
            ...

The line in red is leaving me with an "Object variable or With Block variable not set" error.

Trust access to the VBA project model IS checked in the WATSOP19.xlsm workbook.
 
Upvote 0
I'm not sure as it works for me :confused:

Couple of suggestions / questions:

• What type of control is lb_cntaba_dt (at a guess based on "lb" I thought it was a label)??
• Check there's no references in the Visual Basic Editor that start with MISSING in the WATSOP19.xlsm workbook
• Why can't you just send the missing data to wherever it's meant to go instead of trying to populate the form for the user to click through?
 
Upvote 0
Yes, they are all labels.
Only references with MISSING in them are comments or messages.
I'm not quite sure I follow you. After the user enters the missing data in userform group_1, the data is sent to a database. uf1_main just updates as a avisual reference. For instance, label equals number of records with missing information. Equals 5.
User clicks a button to start resolving missing information. Enters missing information in group_1, submits it, and the "number of records with missing information" is updated to 4. User repeats until the number of records with missing information equals 0. I can keep count of this with a variable, but I also want to update the userform.
 
Upvote 0
Only references with MISSING in them are comments or messages

Not sure what you mean :confused: I meant if you go into the VBE and check if there's any references (Tools > References)that start with MISSING.

Is there more code you're not showing? If so could you please post the entire code?
 
Upvote 0
Ohhh ... no ... nothing there that I can see. There amre a lot of available references, they all refer to a path. Only 5 are checked.
My project is quite large and involves several data sources and network paths with confidential information. It would not benefit anyone to try to post the whole thing as desensitizing things would frustrate a person with all th errors.

Here is what I feel might be relevant code as it follows the path of where we get to the problem. I appreciate your patience.

From uf1_main, click on label "lb_cntmissp"

Rich (BB code):
Private Sub lb_cntmissp_Click()
    If lb_cntmissp.Caption = "0" Then Exit Sub
    With wb_rd
        Application.Run wb_rd.Name & "!macro_01"
    End With
End Sub

Marco_01 is in workbook 2 (ws_rd) which holds userform group_1
Rich (BB code):
Sub macro_01()
    mri = 1 'true
    MsgBox "MRI: " & mri
    declarations_1
End Sub

Declarations (in wb2) called to define objects ...
Rich (BB code):
Public mbevents As Boolean
Public ws_rd As Worksheet
Public ws_rm As Worksheet
Public ws_amm As Worksheet
Public ws_lists As Worksheet
Public ws_Cust As Worksheet
Public ws_group As Worksheet
Public ws_vh As Worksheet
Public pn As Long
Public CH, df1 As Integer
'Public mri As Boolean


Sub declarations_1()
    Set wb_rd = Workbooks("Rental_Detail.xlsm")
    Set ws_rd = wb_rd.Worksheets("Rental_Data")
    Set ws_rm = wb_rd.Worksheets("Rental_Main")
    Set ws_amm = wb_rd.Worksheets("Ammendments")
    Set ws_lists = wb_rd.Worksheets("LISTS")
    Set ws_Cust = wb_rd.Worksheets("Customer_Default")
    Set ws_group = wb_rd.Worksheets("Group_Defaults")
    Set ws_vh = wb_rd.Worksheets("VAR_HOLD")
    
    group_1.Show
End Sub

Group 1 launched ...
Rich (BB code):
Public Sub UserForm_Initialize()
    'Stop
    Dim l_mr As Long
    Dim temp_ws As Worksheet
    Dim CH As Integer
    Dim df1 As Integer
    Dim test_mr
    Dim ai_typelist As String
    Dim lrow_a, lrow_p As Integer
    Dim Cl As Range
    
    'Set temp_ws = Workbooks("schedule.csv").Worksheets("temp_ws")
    
    mbevents = False
    
    CH = 0 'reset customer information change holder (0=no change, 1=change)
    
    'If Application.WorksheetFunction.Count(ws_vh.Range("L:M")) > 0 Then 'mri=true
    If mri = 1 Then
        TextBox1.Visible = False
        MsgBox "Combobox enabled."
        mri = 1 'missing rental flag
'        Stop
    'Else
    '    With TextBox1               'rental number
    '        cb_mri.Visible = False
    '        .Locked = False
    '        .BackColor = RGB(0, 168, 232)
    '        .Value = format(0, "000000") 'new rental
    '        .SetFocus
    '        .SelStart = 0
    '        .SelLength = Len(.Text)
    '    End With
    End If
    
    If l_mr <> 1 Then uf2_eliminate.Visible = False 'NO MISSING RECORDS
    If df1 < 4 Then uf2_eliminate.Visible = True
    
    Label34.Caption = "   Please enter valid permit number."
    proceed1.Enabled = True
    cmdb_agrmnt.Enabled = False
    submit1.Enabled = False
    delete1.Enabled = False
    edit1.Enabled = False
    amm_no.Value = 0
    amm_no.Locked = True
    date1.Value = format(Date, "dd-mmm")
    date1.Locked = True
    ai_type.Value = ""
    ai_type.List = Workbooks("Rental_Detail.xlsm").Names("ai_typelist").RefersToRange.Value
    'ai_type.List = = Workbooks("Rental_Detail")
    ai_type.BackColor = RGB(0, 168, 232) 'celadon blue
    ai_function.BackColor = RGB(255, 255, 255)
    ai_function.Value = ""
    ai_function.Enabled = False
    ai_league.Value = ""
    ai_league.Enabled = False
    ai_calibre.Value = ""
    ai_calibre.Enabled = False
    ai_division.Value = ""
    ai_division.Enabled = False
    ai_event.Value = ""
    ai_event.Enabled = False
    'baseball
    ai_basedist.Value = ""
    ai_basedist.Locked = True
    ai_pitchdist.Value = ""
    ai_pitchdist.Locked = True
    ai_bbox.Value = ""
    ai_bbox.Locked = True
    ai_safety.Value = ""
    ai_safety.Locked = True
    ai_circle.Value = ""
    ai_circle.Locked = True
    ai_mat.Value = ""
    ai_mat.Locked = True
    ai_safeline.Value = ""
    ai_safeline.Locked = True
    ai_commit.Value = ""
    ai_commit.Locked = True
    ai_runline.Value = ""
    ai_runline.Locked = True
    ai_other1.Value = ""
    ai_other1.Locked = True
    ai_other2.Value = ""
    ai_other2.Locked = True
    ai_comment = ""
    'courts
    ai_setup.Value = ""
    ai_setup.Locked = True
    ai_other3.Value = ""
    ai_other3.Locked = True
    ai_other4.Value = ""
    ai_other4.Locked = True
    'fields
    ai_layout.Value = ""
    ai_layout.Locked = True
    ai_goals.Value = ""
    ai_goals.Locked = True
    ai_other5.Value = ""
    ai_other5.Locked = True
    ai_other6.Value = ""
    ai_other6.Locked = True
    'greenspace
    ai_water.Value = False
    ai_water.Locked = True
    ai_hydro.Value = False
    ai_hydro.Locked = True
    ai_attendance = 0
    ai_tables = 0
    ci_league.Locked = True
    ci_affiliated.Value = "N"
    ci_affiliated.Locked = True
    ci_affiliated.BackColor = RGB(255, 255, 255)
    'primary name
    ci_name1.Value = ""
    ci_name1.Locked = True
    ci_name1.BackColor = RGB(255, 255, 255)
    ci_email1.Value = ""
    ci_email1.Locked = True
    ci_email1.BackColor = RGB(255, 255, 255)
    ci_tele1a.Value = format(0, "000.000.0000")
    ci_tele1a.BackColor = RGB(255, 255, 255)
    ci_tele1a.Locked = True
    ci_tele1b.Value = format(0, "000.000.0000")
    ci_tele1b.BackColor = RGB(255, 255, 255)
    ci_tele1b.Locked = True
    'secondary name
    ci_name2.Value = ""
    ci_name2.Locked = True
    ci_name2.BackColor = RGB(255, 255, 255)
    ci_email2.Value = ""
    ci_email2.Locked = True
    ci_email2.BackColor = RGB(255, 255, 255)
    ci_tele2a.Value = format(0, "000.000.0000")
    ci_tele2a.BackColor = RGB(255, 255, 255)
    ci_tele2a.Locked = True
    ci_tele2b.Value = format(0, "000.000.0000")
    ci_tele2b.BackColor = RGB(255, 255, 255)
    ci_tele2b.Locked = True
    
    MultiPage1.Value = 1
    MultiPage1.Visible = False
    MultiPage2.Value = 0
    Frame8.Visible = False
        
    group_1.Height = 124.5
    'If Application.WorksheetFunction.Count(ws_vh.Range("L:M")) = 0 Then
    If mri = 0 Then
        cb_mri.Visible = False
        With TextBox1
            '.BackColor = RGB(255, 255, 255)
            'If l_mr > 0 Then 'this has come in from module 21 reporting missing rentals prior to workorder prep
            '.Value = format(test_mr.miss_rn.Value, "######")
            
            .Locked = False
            .BackColor = RGB(255, 255, 255)
            .Value = format(0, "000000") 'new rental
            .SetFocus
            .SelStart = 0
            .SelLength = Len(.Text)
        End With
     Else 'combobox
        With CreateObject("scripting.dictionary")
            For Each Cl In ws_vh.Columns("L:M").SpecialCells(xlConstants, xlNumbers)
                If Cl <> "" Then .Item(Cl.Value) = Empty
            Next Cl
            Me.cb_mri.List = .Keys
            Me.cb_mri.ListIndex = 0
            If .Count = 1 Then Me.cb_mri.Locked = True
        End With
        cb_mri.BackColor = RGB(255, 255, 255)
        Label34.Caption = "   Select missing rental."
        'mri = False
     End If
        
    'End With
    mbevents = True
End Sub

User completes form and presses [SUBMIT] button ...
Rich (BB code):
Private Sub submit1_Click()   'group_1          `
    'Stop
    Dim ui1 As Integer, r As Integer, f As Integer
    Dim LROw3 As Integer
    Dim Rng As Range
    Dim ma As Variant
    submit1.BackColor = RGB(176, 196, 222)
    submit1.Enabled = False
    If CH = 1 Then 'a customer change was detected
        If Application.WorksheetFunction.CountIf(ws_Cust.Range("A2:A50"), ai_league.Value) = 1 Then 'only update customer data in customer default list
            ui1 = MsgBox("A change to the customer data has been detected." & Chr(13) & "Do you wish to update customer default information for future rentals?", 36, "DATA CHANGE")
            If ui1 = vbYes Then
                'Update customer data
                With ws_Cust
                    On Error Resume Next
                    LROw3 = Application.WorksheetFunction.Match(Me.ci_league.Value, .Range("A2:A500"), 0) + 1
                    On Error GoTo 0
                    If LROw3 > 0 Then
                        .Range("J" & LROw3) = ci_affiliated.Value
                        .Range("B" & LROw3) = ci_name1
                        .Range("C" & LROw3) = ci_tele1a
                        .Range("D" & LROw3) = ci_tele1b
                        .Range("E" & LROw3) = ci_email1
                        .Range("F" & LROw3) = ci_name2
                        .Range("G" & LROw3) = ci_tele2a
                        .Range("H" & LROw3) = ci_tele2b
                        .Range("I" & LROw3) = ci_email2
                    End If
                End With
                'Update affected rentals
                With ws_rd
                    For r = 3 To .Cells(.Rows.Count, "A").End(xlUp).Row
                        If .Range("F" & r) = ai_league.Value Then
                            MsgBox "Row: " & r
                            .Range("J" & r) = ci_affiliated.Value
                            .Range("K" & r) = ci_name1
                            .Range("L" & r) = ci_tele1a
                            .Range("AP" & r) = ci_tele1b
                            .Range("AQ" & r) = ci_email1
                            .Range("AR" & r) = ci_name2
                            .Range("AS" & r) = ci_tele2a
                            .Range("AU" & r) = ci_tele2b
                            .Range("AT" & r) = ci_email2
                            f = f + 1
                        End If
                    Next r
                    MsgBox "Updated rentals: " & f
                End With
            End If
        End If
    End If
    CH = 0
    Call submit2016(df1)  '[group_submit] Submit rental profile into Rental_data
End Sub

Part 2 of submission ... sending data to database and updating userform and stats
Rich (BB code):
Sub submit2016(ByVal df1 As Integer)
    Stop
    
    Dim ui1 As String
    Dim lrow_rd, drow_rd As Integer
    Dim grp_flg As Integer
    Dim pn As Long, mr_tr As Long
    Dim rng_pn As Range
    Dim bmsg As String, msg1 As String, msg2 As String
    Dim esf As Integer
    Dim temp_ws As Worksheet, r As Range
    Dim rngMissing_All As Range
    Dim red_range As Range, dfl_range As Range
    Dim wb As Workbook, nm As String
    Dim VBC As Object ' UserForm VBComponent
    
    'Set temp_ws = wb_sched.Worksheets("temp_ws")
    Set rng_pn = ws_rd.Range("A:A")
    grp_flag = ws_vh.Range("B1").Value '1 = new record 0 = edit
    If mri = 1 Then
        group_1.TextBox1.Value = group_1.cb_mri.Value 'rental number
    End If
    pn = group_1.TextBox1.Value 'rental number
    
    'ws_rd.Activate 'remove
    consistency esf 'all fields complete ESF = 1 then data is missing
    If esf = 1 Then
        group_1.submit1.Enabled = True
        group_1.submit1.BackColor = RGB(198, 241, 198)
        Exit Sub 'consistency failure. Exit
    End If
    
    ui1 = MsgBox("Is the information complete & correct?" & Chr(13) & Chr(13) & "Select [YES] to continue with the current submission, or [NO] to review and make changes.", vbQuestion + vbYesNo, "CONFIRMATION")
    
    If ui1 = vbNo Then
        group_1.submit1.Enabled = True
        Exit Sub
    
    Else 'determine destination row number
        With ws_rd
        If grp_flag = 1 Or mri = 1 Then 'new group entry
            lrow_rd = .Cells(.Rows.Count, "A").End(xlUp).Row      'rental_data - last row of current database
            drow_rd = lrow_rd + 1                                   'rental_data - destination row for new entry
            bmsg = "Rental no. " & pn & " successfully added and saved."
        Else 'replace existing (edit) grp_flag = 0
            drow_rd = Application.WorksheetFunction.Match(pn, rng_pn, 0)    'destination row = row of existing rental
            'MsgBox "Replaces row: " & drow_rd
            bmsg = "Rental no. " & pn & " successfully updated."
        End If
        End With
    End If
    
        'transfer field entries to rental database
    With ws_rd
        If .AutoFilterMode Then .AutoFilterMode = False
        'ws_rd.Activate
        .Cells(drow_rd, 1) = group_1.TextBox1.Value
        .Cells(drow_rd, 2) = group_1.amm_no.Value
        
        .Cells(drow_rd, 3) = group_1.ai_type.Value
        .Cells(drow_rd, 4) = group_1.ai_event.Value
        .Cells(drow_rd, 5) = group_1.ai_function.Value
        .Cells(drow_rd, 6) = group_1.ai_league.Value
        .Cells(drow_rd, 7) = group_1.ai_calibre.Value
        .Cells(drow_rd, 8) = group_1.ai_division.Value
        .Cells(drow_rd, 9) = group_1.ai_function.Value & group_1.ai_league.Value & group_1.ai_calibre.Value & group_1.ai_division.Value
        
        .Cells(drow_rd, 10) = group_1.ci_affiliated.Value
        .Cells(drow_rd, 11) = group_1.ci_name1.Value
        .Cells(drow_rd, 12) = group_1.ci_tele1a.Value
        
        If group_1.ai_type Like "D*" Then
            .Cells(drow_rd, 17) = "YES" 'foul lines
        Else
            .Cells(drow_rd, 17) = "NO"
        End If
        .Cells(drow_rd, 13) = group_1.ai_basedist.Value
        .Cells(drow_rd, 14) = group_1.ai_safety.Value
        .Cells(drow_rd, 15) = group_1.ai_bbox.Value
        .Cells(drow_rd, 16) = group_1.ai_safeline.Value
        .Cells(drow_rd, 18) = group_1.ai_runline.Value
        .Cells(drow_rd, 19) = group_1.ai_commit.Value
        .Cells(drow_rd, 20) = group_1.ai_pitchdist.Value
        .Cells(drow_rd, 21) = group_1.ai_circle.Value
        .Cells(drow_rd, 22) = "NR"
        .Cells(drow_rd, 23) = group_1.ai_mat.Value
        .Cells(drow_rd, 24) = group_1.ai_other1.Value
        .Cells(drow_rd, 25) = group_1.ai_other2.Value
        
        .Cells(drow_rd, 26) = group_1.ai_layout.Value
        .Cells(drow_rd, 27) = group_1.ai_goals.Value
        .Cells(drow_rd, 28) = group_1.ai_other5.Value
        .Cells(drow_rd, 29) = group_1.ai_other6.Value
        
        .Cells(drow_rd, 30) = group_1.ai_setup.Value
        .Cells(drow_rd, 31) = group_1.ai_other3.Value
        .Cells(drow_rd, 32) = group_1.ai_other4.Value
        
        .Cells(drow_rd, 33) = group_1.ai_water.Value
        .Cells(drow_rd, 34) = group_1.ai_hydro.Value
        .Cells(drow_rd, 35) = group_1.ai_attendance.Value
        .Cells(drow_rd, 36) = group_1.ai_tables.Value
        .Cells(drow_rd, 37) = group_1.ai_other7.Value
        .Cells(drow_rd, 38) = group_1.ai_other8.Value
        .Cells(drow_rd, 39) = group_1.ai_other9.Value
        .Cells(drow_rd, 40) = group_1.ai_comment.Value
        
        .Cells(drow_rd, 41) = format(group_1.date1.Value, "dd-mmm-yy") 'submission date
        
        .Cells(drow_rd, 42) = group_1.ci_tele1b.Value
        .Cells(drow_rd, 43) = group_1.ci_email1.Value
        .Cells(drow_rd, 44) = group_1.ci_name2.Value
        .Cells(drow_rd, 45) = group_1.ci_tele2a.Value
        .Cells(drow_rd, 46) = group_1.ci_tele2a.Value
        .Cells(drow_rd, 47) = group_1.ci_email2.Value
    End With

    'closing arguments (what happens after submission is made)
    
    lastrow = ws_rd.Cells(ws_rd.Rows.Count, "A").End(xlUp).Row
    ws_rd.Range("A3:FZ" & lastrow).Sort key1:=ws_rd.Range("A3"), Order1:=xlAscending, Header:=xlNo
    drow_rd = Application.WorksheetFunction.Match(pn, rng_pn, 0) 'new record row location
    
    group_1.Label34.Caption = "    " & bmsg
    group_1.Label34.BorderColor = RGB(50, 205, 50)
    group_1.Caption = "USER GROUP     [E" & drow_rd & "]"
    
    Debug.Print ThisWorkbook.Name
    ui1 = MsgBox("Save rental changes? {Sports17.xlsm}", vbYesNo, "TO BE REMOVED LATER")
    'ui1 = vbYes
    If ui1 = vbYes Then
        Application.DisplayAlerts = False
        Workbooks("Rental_Detail.xlsm").Save
        Application.DisplayAlerts = True
    End If
    If InStr(bmsg, "updated") <> 0 Then
        MsgBox "Rental " & pn & " successfulling updated and saved to rental database.", vbInformation, "CONFIRMATION"
    Else
        MsgBox "Rental " & pn & " successfulling added and saved to rental database.", vbInformation, "CONFIRMATION"
    End If
        
    If mri = 0 Then 'standard
        'reset rental form to enter additional
        Unload group_1
        group_1.Show
    
    Else 'ends rental entry unless more missing information exists
        
        'update missing rental list; remove rental number from var_hold
        With ws_vh.Range("L:M")
            Set c = .Find(pn)
            MsgBox pn & " found at: " & c.Address, , "Rental_Detail.xlsm [VAR_HOLD]"
            c.Delete shift:=xlUp
        End With
        'update missing rental list; remove rental number from Temp1
        With Workbooks("WATSOP19.xlsm").Worksheets("Temp1").Range("A:B")
            Set c = .Find(pn)
            MsgBox pn & " found at: " & c.Address, , "WATSOP19.xlsm [TEMP1]"
            c.Delete shift:=xlUp
        End With
            
        'update data
        'find data workbook
        For Each wb In Application.Workbooks
            If wb.Name Like "*Data.xlsx" Then
                nm = wb.Name
                Set ws_schedule = Workbooks(nm).Worksheets("Schedule")
            End If
        Next
        
        'update schedule replacing #N/A with type
        With ws_schedule
            lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            For rw = 2 To lrow
                If IsError(.Cells(rw, 4)) Then
                    .Cells(rw, 4) = Application.WorksheetFunction.VLookup(pn, ws_rd.Range("A:C"), 3, False)
                End If
            Next rw
        End With
        
        'update type stats
        Application.Run "WATSOP19.xlsm!cnt_type"
        Set VBC = Workbooks("WATSOP19.xlsm").VBProject.VBComponents("uf1_main")
        'update userform
       
        'active
        VBC.Designer.Controls("lb_cntaba_dt").Caption = cnt_dt
            If cnt_dt = 0 Then
                VBC.Designer.Controls("lb_cntaba_dt").Enabled = False
                VBC.Designer.Controls("lb_aba_dt").Enabled = False
            End If
        VBC.Designer.Controls("lb_cntaba_dr").Caption = cnt_dr
            If cnt_dr = 0 Then
                VBC.Designer.Controls("lb_cntaba_dr").Enabled = False
                VBC.Designer.Controls("lb_aba_dr").Enabled = False
            End If
        VBC.Designer.Controls("lb_cntaba_ft").Caption = cnt_ft
            If cnt_ft = 0 Then
                VBC.Designer.Controls("lb_cntaba_ft").Enabled = False
                VBC.Designer.Controls("lb_aba_ft").Enabled = False
            End If
        VBC.Designer.Controls("lb_cntaba_fr").Caption = cnt_fr
            If cnt_fr = 0 Then
                VBC.Designer.Controls("lb_cntaba_fr").Enabled = False
                VBC.Designer.Controls("lb_aba_fr").Enabled = False
            End If
        VBC.Designer.Controls("lb_cntaba_ct").Caption = cnt_ct
            If cnt_ct = 0 Then
                VBC.Designer.Controls("lb_cntaba_ct").Enabled = False
                VBC.Designer.Controls("lb_aba_ct").Enabled = False
            End If
        VBC.Designer.Controls("lb_cntaba_cr").Caption = cnt_cr
            If cnt_cr = 0 Then
                VBC.Designer.Controls("lb_cntaba_cr").Enabled = False
                VBC.Designer.Controls("lb_aba_cr").Enabled = Falsee
            End If
        VBC.Designer.Controls("lb_cntaba_ab").Caption = cnt_active
            If cnt_active = 0 Then
                VBC.Designer.Controls("lb_cntaba_ab").Enabled = False
                VBC.Designer.Controls("lb_aba_ab").Enabled = False
            End If
        VBC.Designer.Controls("lb_cntmissa").Caption = Application.WorksheetFunction.Count(ws_temp1.Columns(1))
    
        If VBC.Designer.Controls("lb_cntmissa").Caption > "0" Then
            VBC.Designer.Controls("lb_cntmissa").BackColor = RGB(170, 6, 36)
            VBC.Designer.Controls("lb_cntmissa").ForeColor = RGB(255, 255, 255)
            VBC.Designer.Controls("lb_cntaba_dt").Enabled = False
            VBC.Designer.Controls("lb_cntaba_dr").Enabled = False
            VBC.Designer.Controls("lb_cntaba_ft").Enabled = False
            VBC.Designer.Controls("lb_cntaba_fr").Enabled = False
            VBC.Designer.Controls("lb_cntaba_ct").Enabled = False
            VBC.Designer.Controls("lb_cntaba_cr").Enabled = False
            VBC.Designer.Controls("lb_cntaba_ab").Enabled = False
            VBC.Designer.Controls("lb_aba_dt").Enabled = False
            VBC.Designer.Controls("lb_aba_dr").Enabled = False
            VBC.Designer.Controls("lb_aba_ft").Enabled = False
            VBC.Designer.Controls("lb_aba_fr").Enabled = False
            VBC.Designer.Controls("lb_aba_ct").Enabled = False
            VBC.Designer.Controls("lb_aba_cr").Enabled = False
            VBC.Designer.Controls("lb_aba_ab").Enabled = False
        Else
            VBC.Designer.Controls("lb_cntmissa").Enabled = False
            VBC.Designer.Controls("lb_missa").Enabled = False
        End If
    'passive
        VBC.Designer.Controls("lb_cntpba_pc").Caption = cnt_pc
            If cnt_pc = 0 Then
                VBC.Designer.Controls("lb_cntpba_pc").Enabled = False
                VBC.Designer.Controls("lb_pba_pc").Enabled = False
            End If
        VBC.Designer.Controls("lb_cntpba_bs").Caption = cnt_bs
            If cnt_bs = 0 Then
                VBC.Designer.Controls("lb_cntpba_bs").Enabled = False
                VBC.Designer.Controls("lb_pba_bs").Enabled = False
            End If
        VBC.Designer.Controls("lb_cntpba_lg").Caption = cnt_lg
            If cnt_lg = 0 Then
                VBC.Designer.Controls("lb_cntpba_lg").Enabled = False
                VBC.Designer.Controls("lb_pba_lg").Enabled = False
            End If
        VBC.Designer.Controls("lb_cntpba_vg").Caption = cnt_vg
            If cnt_vg = 0 Then
                VBC.Designer.Controls("lb_cntpba_vg").Enabled = False
                VBC.Designer.Controls("lb_pba_vg").Enabled = False
            End If
        VBC.Designer.Controls("lb_cntpba_gm").Caption = cnt_gm
            If cnt_gm = 0 Then
                VBC.Designer.Controls("lb_cntpba_gm").Enabled = False
                VBC.Designer.Controls("lb_pba_gm").Enabled = False
            End If
        VBC.Designer.Controls("lb_cntpba_pb").Caption = cnt_passive
            If cnt_passive = 0 Then
                VBC.Designer.Controls("lb_cntpba_pb").Enabled = False
                VBC.Designer.Controls("lb_pba_pb").Enabled = False
            End If
        
        VBC.Designer.Controls("lb_cntmissp").Caption = Application.WorksheetFunction.Count(ws_temp1.Columns(2))
        If VBC.Designer.Controls("lb_cntmissp").Caption > "0" Then
            VBC.Designer.Controls("lb_cntmissp").BackColor = RGB(170, 6, 36)
            VBC.Designer.Controls("lb_cntmissp").ForeColor = RGB(255, 255, 255)
            VBC.Designer.Controls("lb_cntpba_pc").Enabled = False
            VBC.Designer.Controls("lb_cntpba_lg").Enabled = False
            VBC.Designer.Controls("lb_cntpba_bs").Enabled = False
            VBC.Designer.Controls("lb_cntpba_gm").Enabled = False
            VBC.Designer.Controls("lb_cntpba_vg").Enabled = False
            VBC.Designer.Controls("lb_cntpba_pb").Enabled = False
            VBC.Designer.Controls("lb_pba_pc").Enabled = False
            VBC.Designer.Controls("lb_pba_lg").Enabled = False
            VBC.Designer.Controls("lb_pba_bs").Enabled = False
            VBC.Designer.Controls("lb_pba_gm").Enabled = False
            VBC.Designer.Controls("lb_pba_vg").Enabled = False
            VBC.Designer.Controls("lb_pba_pb").Enabled = False
         Else
            VBC.Designer.Controls("lb_cntmissp").Enabled = False
            VBC.Designer.Controls("lb_missp").Enabled = False
        End If

            
        With ws_vh
            cnt_mr = Application.WorksheetFunction.Count(.Range("L:M"))
            
            If cnt_mr = 0 Then 'no more missing records, resume WATSOP19.uf1_main1
                Application.DisplayAlerts = False
                'wb_rd.Save
                wb_rd.Close
                Application.DisplayAlerts = True
            Else 'return to group_1 to process rremaining missing rentals
                mri = 1
                Unload group_1
                group_1.Show
            End If
        
        End With
    End If
End Sub

The purple section is where uf1_main's labels are supposed to update.

Now, both forms have the modal properties set to False. Could this be a problem? It has caused me grief in the past.
 
Upvote 0

Forum statistics

Threads
1,214,647
Messages
6,120,722
Members
448,987
Latest member
marion_davis

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