Run all subs from one module in Personal.xslb

[ceytl]

Hello All,

I am trying to run 7 subs in one module in my personal.xslb

It works if run it in the actual spreadsheet module, but not in a personal.xslb module.

I also would like to know how to have only one mater sub name, and the other names hidden.

Here is what I pasted into one moduel:

Sub Main()
AddNewWorksheet1
PasteValues2
Copy_ShipTo_PO3
ShipTo4
Compress5
DeleteColumns6
Save7
End Sub
Sub AddNewWorksheet1()
    With ThisWorkbook
    On Error Resume Next
        .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Import"
    End With
End Sub
Sub PasteValues2()

Dim rng As Range

  Set rng = Worksheets("Sheet1").Range("A1:Z100")

  Worksheets("Import").Range("A1").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value

End Sub
Sub Copy_ShipTo_PO3()

    'The Range.Copy Method - Copy & Paste with 1 line
    Range("L20").Copy Range("G1")
   
    Range("J36").Copy Range("F1")
   
   
End Sub
Sub ShipTo4()

    Select Case Range("F1")
        Case "New York"
            Range("F1") = 21
        Case "LA"
            Range("F1") = 22
        Case "Portland"
            Range("F1") = 23
        Case "Chicago"
            Range("F1") = 24
        Case "Miami"
            Range("F1") = 25
    End Select
   
End Sub
Sub Compress5()

Dim c As Range, Rg As Range, Fnd As Range

For Each c In Columns("I").SpecialCells(2)
   If Fnd Is Nothing Then Set Fnd = [C1]
   Set Rg = Columns(3).Find("Part No.:", lookat:=xlWhole, After:=Fnd)
   Set Fnd = Columns(3).Find("Part No.:", lookat:=xlWhole, After:=Fnd)
   Rg.Offset(, 4) = c
Next

   Range("G2:G" & Rows.Count).SpecialCells(xlBlanks).EntireRow.Delete

End Sub
Sub DeleteColumns6()

Dim cols As Variant, v As Variant
Dim j As Long, n As Long
Dim col As String
Dim Rg As Range
 
With ActiveSheet
    cols = Array("F", "G")
    n = .Columns.Count
    On Error Resume Next
    For j = 1 To n
        col = Split(.Columns(j).Address(False, False, xlA1), ":")(0)
        If IsError(Application.Match(col, cols, 0)) Then
            If Rg Is Nothing Then
                Set Rg = .Columns(j)
            Else
                Set Rg = Union(Rg, .Columns(j))
            End If
        End If
    Next
    On Error GoTo 0
    
    Rg.EntireColumn.Delete
    'rg.EntireColumn.Clear
End With
End Sub
Sub Save7()
   
    Application.ScreenUpdating = False
   
    On Error GoTo ErrCatcher
    Sheets("Import").Copy
    On Error GoTo 0
   
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\PO " & Range("B1").Value, FileFormat:=6
   
    Application.ScreenUpdating = True
    Exit Sub
   
ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"
End Sub

Thanks

 

[ceytl]

I figured out my problem. I used ThisWorkbook instead of ActiveWorkbook.

 

[Domenic]

Glad you were able to resolve your issue. To hide those subs that you're calling, you can add an optional dummy parameter. Here's an example...

Sub AddNewWorksheet1(Optional dummy As Long)
    'etc
    '
    '
End Sub

Hope this helps!