Problem with code working in one version and same code not working in another version.

Mackeral

Board Regular
Joined
Mar 7, 2015
Messages
145
I run two versions of subroutine that are essentially the same, but one does not work.

A Testing Macro is:
VBA Code:
Sub A()

    GoTo Y1      or    X9
      
X9: Call Initialize_Globals
      Call Test2
    End
    
Y1: Call Compile_Ribbon_Code <-- Call to "Initialize_Globals is included in this version.
    End
End Sub


The problem has to do with the availability of a public array defined as RIBBON:
Code:
Public RIBBON As Worksheet
Set RIBBION = Sheets("Ribbon")
When "Test2" is called from the macro, the subroutine works, but when I call "Compile_Ribbon_Code" with the call to "Initialize_Globals" in it, I can test in the initialization and see the data in RIBBON, but when I exit back into "Compile_Ribbon_Code", RIBBON shows an error message: "Object variable with Block Variable not Set."


This is the code of the problematic subroutine:
Code:
Sub vb_Compile_Ribbon_Code()
    ' 10/21/14 Created WML
    ' 2/16/15 Reworked. WML
    ' 8/8/16 Modified. WML
    ' 10/25/18 Changed Labeling and added "Screen_Updating". WML
    ' 11/4/18 Reworked. WML
    ' 12/5/18 Reworked.
    ' 3/18/19 Copied in from Library.xlsm and reworked. WML
    ' 9/20/19 Changes in both Case 1 & 3. WML
    ' 10/12/19 Changed Ribbon File write out to Col 3. WML
    ' 11/26/20 Deleted "Manu" and "Ribbon" definitions. WML
        
    Prog = "vb_Ribbon_Compiler"
    
    ' The variables not defined explictly here are defined in a Setup module, so it's not  an un-assigned variable.

'   Initializations
    Call Initialize_Globals
    MsgBox RIBBON.Cells(1, 1)  ' <-- shows "Object variable with Block Variable not Set."
    Menu_Row = 2
    Ribn_Row = 1
    Prog_Row = 1
    Button_Nr = 0
'    RIBBON.Activate
    Screen_Update_Flag = False
'    Call Data_Clear_Rows(RIBBON, 1, -1)

    ' Prep Ribbon Code
    Line = ""
    Title = ActiveWorkbook.Name
    Date__Time = Format(Date, "mm/dd/yy") & " " & Format(Time, "h:mm")
    Line = "<!-- Compiled from """ & UCase(Title) & """ on " & Date__Time & " -->"
    Call vc_Ribbon_Update(0, Line, Ribn_Row)
    System_Tabs = "File,Home,Insert,Page Layout,Formulas,Data,Review,Develope,Help"

    'Compile Ribbon Code
    Line = "<customUI xmlns=""http://schemas.microsoft.com/office/2009/07/customui"" >"
    Call vc_Ribbon_Update(0, Line, Ribn_Row)
    Call vc_Ribbon_Update(1, "<ribbon>", Ribn_Row)
    Call vc_Ribbon_Update(2, "<tabs>", Ribn_Row)


'   Add the menus, menu items and submenu items using
'   DATA stored on MENU

    Do Until IsEmpty(MENU.Cells(Menu_Row, 1))
        With MENU
            MenuLevel = .Cells(Menu_Row, 1)
            Caption = .Cells(Menu_Row, 2)
            Macro = .Cells(Menu_Row, 3)
            FaceId = .Cells(Menu_Row, 4)
            NextLevel = .Cells(Menu_Row + 1, 1)
        End With

        Select Case MenuLevel

            Case 1 ' Add the top-level menu to the Worksheet CommandBar
                ' <tab id="sample" label="Sample"> 9/12/19
                Call Text_Before_After(FaceId, "-", Where, Tab_Name)
                If Not List_Contains(Tab_Name, System_Tabs) Then
                    msg1 = """Tab"" specification """ & Macro & """ is illegal."
                    Call Msg_Err(Prog, msg1, , True)
                    Exit Sub
                End If
                If Not List_Contains(Where, "Before,After") Then
                    msg1 = """Where"" specification is illegel:"
                    Msg2 = Quote(Where)
                    Call Msg_Err(Prog, msg1, Msg2)
                    Exit Sub
                End If

                Name = Quote(Caption)
                Tab_Where = "Tab" & Where
                If Where = "After" Then
                    Line1 = Line1 & " insertAfterMso=" & Quote(Tab_Where) & " >"
                ElseIf Where = "Before" Then
                    Line1 = Line1 & " insertBeforeMso=" & Quote(Tab_Where) & " >"
                Else
                    Msg = "Illegal Side Specification"
                    Call Msg_Err(Prog, Msg, """" & Tab_Id & """")
                End If
                Call vc_Ribbon_Update(3, Line1, Ribn_Row)

                ' Attribute VB_Name = "Std_Lib_VB_Library"
                ' STD LIBRARY FUNCTIONS, VBA LIB, 9/15/11
                Line2 = "Attribute VB_Name = ""Ribbon_Calls"""
                Call vc_Prog_Update(0, Line2, Prog_Row)
                TS = UCase(Text_Before(Title, "."))
                Line3 = " ' RIBBON Calls for " & TS & ", " & Format(Date + Time, "mm/dd/yy hh:mm")
                Call vc_Prog_Update(0, Line3, Prog_Row)
                Prog_Row = Prog_Row + 1

            Case 2 ' A Menu Item
                ' <group id="changeValues" label="Change Values">
                If Case3_Flag Then
                    Line4 = "</group>"
                    Call vc_Ribbon_Update(4, Line4, Ribn_Row)
                End If

                Caption = Substitute(Caption, " ", "_")
                Button_Group = Substitute(Caption, " ", "_")
                Line5 = "<group id=""" & Button_Group & """ label=""" & Caption & """>"
                Call vc_Ribbon_Update(4, Line5, Ribn_Row)

'                If FaceId <> "" Then MenuItem.FaceId = FaceId
'                If Divider Then MenuItem.BeginGroup = True

                Group_Caption = Caption
                Group_Knt = Group_Knt + 1

            Case 3 ' A SubMenu Item
                ' <button id="idNegate" label="Change Sign" onAction="negate" />
                ' Changes 9/12/19.

                If Macro = "" Then
                    Call_Line = "Msg_Err(""vb_Compile"", """ & Group_Caption & "_" & Button_Name & _
                                            " not implemented yet"",""" & Caption & """)"
                Else
                    Ptr = InStr(Macro, "_")
                    If Ptr = 0 And Len(Macro) > 1 Then
                        Msg = "Macro Name doesn't have a ""_"" in it."
                        Call Msg_Err(Prog, Msg, Macro)
                    Else
                        Macro_Name = Mid(Macro, Ptr + 1, 99)
                        Call_Line = Macro
                    End If
                End If

                Button_Nr = Button_Nr + 1
                Button_Id = "Button_" & Button_Nr
                TEMP = Group_Caption & "_" & Macro
                Caption = Substitute(TEMP, " ", "_")

                Line6 = "<button id=""" & Button_Id & """ label=""" & Caption & _
                             """ onAction=""" & Macro & """ />"
                Call vc_Ribbon_Update(5, Line6, Ribn_Row)

                TS = String_Replace(Button_Id, " ", "_")
                Line7 = "Sub " & TS & "(control As IRibbonControl)"
                Call vc_Prog_Update(0, Line7, Prog_Row)
                Call vc_Prog_Update(6, "Call " & Call_Line, Prog_Row)
                Line8 = "      Call Screen_Updating(True)"
                Call vc_Prog_Update(0, Line8, Prog_Row)

                Line = "End Sub"
                Call vc_Prog_Update(0, Line, Prog_Row)
                Prog_Row = Prog_Row + 1

                Case3_Flag = True

        End Select
        Menu_Row = Menu_Row + 1
    Loop

    Call vc_Ribbon_Update(4, "</group>", Ribn_Row)
    Call vc_Ribbon_Update(3, "</tab>", Ribn_Row)
    Call vc_Ribbon_Update(2, "</tabs>", Ribn_Row)
    Call vc_Ribbon_Update(1, "</ribbon>", Ribn_Row)
    Call vc_Ribbon_Update(0, "</customUI>", Ribn_Row)

    ' Write out Ribbon File.
    Path = ActiveWorkbook.Path & "\"
    TS = Mid_Str(ActiveWorkbook.Name, ".", 1)
    File_Name = TS & " RIBBON Calls.BAS"
    Rowsx = File_Write("Ribbon", Path, File_Name, 1, 3, -1, 3, ",")

    Msg = Strings_Join(Prog, _
          "Ribbon Compiliation Sucessful.", _
          , _
          Rowsx & " rows of Ribbon Calls have been copied to", _
          "    Path: """ & Path & """||", _
          "    File: """ & File_Name & """||", _
          "and is available to either be pasted ", _
          "or copied into the Ribbon Calls module.|", _
          , _
          "The XML Code has been copied into the ", _
          "clipboard for pasting the Custome UI ", _
          "Editor, and the Workbook has been saved.")

    Call Msg_Info(Prog, Msg, False)

    If Trace() Then
        ActiveWorkbook.Save
    Else
        ActiveWorkbook.Close SaveChanges:=True
    End If

    ' Copy CustomeUI Code.
    TS = Last_Row("Ribbon", 1)
    Rng = Make_Range(1, 1, TS, 1, "Ribbon")
    Call Data_Copy("Ribbon", Rng)

End Sub ' vb_Compile_Ribbon_Code

I have even done a text compare on the the in both routines and they are exactly the same.

Thanks for any help you can give,
Mac
 

Some videos you may like

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

Mackeral

Board Regular
Joined
Mar 7, 2015
Messages
145
The problem turned out to be 2 definitions of the same variable RIBBON.

Found that after doing the original post.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,387
Messages
5,624,389
Members
416,026
Latest member
melvic69

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
Top