Link to home
Start Free TrialLog in
Avatar of Jimi Sherman
Jimi ShermanFlag for United States of America

asked on

How to insert a module macro into a workbook after a macro runs?

I have a current macro that I want to insert into a workbook AFTER I run another macro that formats the workbook...is this possible?
Example: I open a workbook with data on it. Now I will run a macro to format the data...then at the end it will insert a module macro so a user can run it.
Thanks,
Jimi
Avatar of Joe Howard
Joe Howard
Flag of United States of America image

Yes, it is possible. The exact code depends on whether you're copying the code from an existing module (in a different project), or creating new code and whether you want to create a new module for the macro. All of the above and much more you can find on Chip Pearson's site. Here is a small sample:
Sub CreateProcedure()
    Dim VBComp As VBIDE.VBComponent
    Dim CodeMod As VBIDE.CodeModule
    Dim S As String
    Dim LineNum As Long
    
    ' Use the next two lines to create a new module for the code
    'Set VBComp = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule)
    'VBComp.Name = "NewModule"
    ' OR use the following line to use an existing module for the code
    'Set VBComp = ThisWorkbook.VBProject.VBComponents("Module2")    
    
    Set CodeMod = VBComp.CodeModule
    LineNum = CodeMod.CountOfLines + 1
    S = "Sub HelloWorld()" & vbCrLf & _
        "    MsgBox ""Hello, World""" & vbCrLf & _
        "End Sub"
    CodeMod.InsertLines LineNum, S
End Sub

Open in new window


 This code creates the procedure:
    Sub HelloWorld()
        MsgBox "Hello, World"
    End Sub

Open in new window

Avatar of Jimi Sherman

ASKER

Hi Macroshadow, I don't understand I am kinda of new at this. Where would I put this in my macro?
Sub BH_Format_Master_Eq_Scan()

    Dim cell As Range
    Application.ScreenUpdating = False
'No apartment # move over
        Dim iLstRow As Long
        Dim iRow As Long
        iLstRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
        For iRow = 2 To iLstRow Step 1
            If Cells(iRow, "N").Value = "" Then
                'This is the move part.  It will cut the range from the first to the second and paste in the column set after the .Cut part
                Cells(iRow, "N").Value = Cells(iRow, "M").Value
                Cells(iRow, "M").Value = ""
            End If
        Next iRow
'split up address
    Columns("O:P").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("N:N").Select
    Selection.TextToColumns Destination:=Range("N1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    Columns("O:O").Select
'trim state Remove blankspaces
    Dim rng As Range
    For Each rng In Intersect(ActiveSheet.UsedRange.Cells, ActiveSheet.Range("O:O"))
    rng.Value = Application.WorksheetFunction.Trim(rng.Value)
    Next
    Selection.TextToColumns Destination:=Range("O1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    Columns("P:P").Select
    Selection.Delete Shift:=xlToLeft
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "State"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Acct"
    Range("A2").Select
    
    Application.ScreenUpdating = True
End Sub

Open in new window

Avatar of Norie
Norie

Couldn't you use a template workbook with the code already in it?
I don't think that will work due to I am taken 3 workbooks and merging them into 1. Then I am run my macro on that Merged workbook to format it.
What wouldn't work?

Also, why do you need this code in the workbook you are creating by merging the other workbooks?
When I merge the 3 files into one that would make a NEW workbook. I not sure how I would get that into a template?
The macro I want to insert is for is for a user. This file will be sent out daily I don't want to copy and paste the USER macro all the time.
Is the code you posted, the code to write to the module? (if not please post it).
Where in your code are you creating the new workbook?
The code I posted earlier is the FORMATTING part after I merge the 3 files.
At the end of that code I would like to insert this code as a module.

Sub BH_Enter_SerialNumber_ORLANDO()
    Dim sWorkbookName As String
    Dim sWorkbookName2 As String
    Dim sWorkbookNamePath As String
    Dim sWorkbookNamePath2 As String
    Dim sScanSerial As String
    Dim fCell, dCell, lCell, eCell, cCell, nCell, oCell, pCell As String
    Dim sAcct, sAddress, sBillCode As String
    Dim sMarket As String
    Dim sTechID As String
    Dim sOffice As String
    Dim sWorkID As String
    Dim iRow As Long
    Dim iRet As Integer

    sMarket = "CFL" 'CFL or TPA
    sTechID = "1234" 'Office managers #
    sOffice = "Orlando"
    
    On Error Resume Next
    sWorkbookName = ThisWorkbook.Name
    Windows(sWorkbookName).Activate
    sWorkbookNamePath = ActiveWorkbook.FullName
    sWorkbookName2 = IsWbOpen(sOffice & "-LABS_Returned_EQ")
    If sWorkbookName2 = "" Then
        iRet = MsgBox("Start a New Equipment Scan spreadsheet?", vbYesNo, "Box Serial Lookup")
        If iRet = 7 Then
            ChDrive Left(sWorkbookNamePath, 3)
            ChDir Left(sWorkbookNamePath, InStrRev(sWorkbookNamePath, "\"))
            filetoopen = Application.GetOpenFilename(Title:="Please choose a Return file to add to", FileFilter:=sOffice & "-LABS_Returned_EQ (*.xlsx),")
            If filetoopen = False Then
                Beep
                MsgBox "No file specified.", vbExclamation, "Error!"
                Exit Sub
            Else
                sWorkbookNamePath2 = filetoopen
                Workbooks.Open (sWorkbookNamePath2)
            End If
        Else
            sWorkbookNamePath2 = Left(sWorkbookNamePath, InStrRev(sWorkbookNamePath, "\")) & sOffice & "-LABS_Returned_EQ_" & Format(Date, "yyyy-mm-dd") & ".xlsx"
            If FileOrDirExists(sWorkbookNamePath2) Then
                Workbooks.Open (sWorkbookNamePath2)
            Else
                Workbooks.Add
                Range("A1").Select
                ActiveCell.FormulaR1C1 = "Work Order ID"
                Range("B1").Select
                ActiveCell.FormulaR1C1 = "Contractor Abb"
                Range("C1").Select
                ActiveCell.FormulaR1C1 = "Market Abb"
                Range("D1").Select
                ActiveCell.FormulaR1C1 = "WA Tech ID"
                Range("E1").Select
                ActiveCell.FormulaR1C1 = "WO Close Date"
                Range("F1").Select
                ActiveCell.FormulaR1C1 = "Flag Reporting"
                Range("G1").Select
                ActiveCell.FormulaR1C1 = "LOB"
                Range("H1").Select
                ActiveCell.FormulaR1C1 = "TASK Code"
                Range("I1").Select
                ActiveCell.FormulaR1C1 = "Task Code Quanity"
                Range("J1").Select
                ActiveCell.FormulaR1C1 = "Start Date"
                Range("K1").Select
                ActiveCell.FormulaR1C1 = "End Date"
                Range("L1").Select
                ActiveCell.FormulaR1C1 = "Arrival Time"
                Range("M1").Select
                ActiveCell.FormulaR1C1 = "Job Notes (Serials)"
                Range("N1").Select
                ActiveCell.FormulaR1C1 = "Acc #"
                Range("O1").Select
                ActiveCell.FormulaR1C1 = "Address"
                Range("P1").Select
                ActiveCell.FormulaR1C1 = "City"
                Range("Q1").Select
                ActiveCell.FormulaR1C1 = "State"
                Range("R1").Select
                ActiveCell.FormulaR1C1 = "ZIP"
                Range("S1").Select
                ActiveCell.FormulaR1C1 = "Amount Owed"
                Range("T1").Select
                ActiveCell.FormulaR1C1 = "Amount Collected"
                Range("U1").Select
                ActiveCell.FormulaR1C1 = "Market Area Abb"
                Range("A2").Select
            'format
                Columns("A:A").Select
                Selection.NumberFormat = "@"
                Columns("E:E").Select
                Selection.NumberFormat = "mm/dd/yyyy"
                Columns("J:K").Select
                Selection.NumberFormat = "mm/dd/yyyy"
                Columns("M:M").Select
                Selection.NumberFormat = "@"
                Rows("1:1").Select
                Selection.Font.Bold = True
                Cells.Select
                With Selection
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                End With
                Columns("M:R").Select
                With Selection
                    .HorizontalAlignment = xlLeft
                    .VerticalAlignment = xlCenter
                End With
                Range("A2").Select
                ActiveWindow.FreezePanes = True
                
                ActiveWorkbook.SaveAs Filename:=sWorkbookNamePath2, _
                    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            End If
        End If
        sWorkbookName2 = ActiveWorkbook.Name
    Else
        sWorkbookNamePath2 = Left(sWorkbookNamePath, InStrRev(sWorkbookNamePath, "\")) & sWorkbookName2
    End If
    Windows(sWorkbookName).Activate
    Sheets("Merge Files").Select
'========================================================================================================
'Scan process
    Windows(sWorkbookName2).Activate
    iRow = Cells(Rows.Count, "B").End(xlUp).Row + 1
    Range("A" & iRow).Select
Reenter:
    sScanSerial = InputBox("Scan or type equipment serial number", "Serial Number Processor")
    sScanSerial = Replace(sScanSerial, "*", "")
    If Len(Trim(sScanSerial)) < 5 And Len(Trim(sScanSerial)) > 0 Then
        Beep
        MsgBox "Serial numbers need to be at least 5 characters.", vbOKOnly, "Illegal entry error"
        GoTo Reenter
    End If
    While sScanSerial > ""
        Windows(sWorkbookName).Activate
        cCell = "C" 'Mt Area
        dCell = "D" 'Acct number from list
        eCell = "E" 'Billing Code
        lCell = "L" 'ADDRESS from list
        nCell = "N" 'City
        oCell = "O" 'State
        pCell = "P" 'Zip
        fCell = "M1" 'Serial Number added to log
        Range(fCell).Select
        Cells.Find(What:=sScanSerial, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
            SearchFormat:=False).Activate
        If ActiveCell.Address <> "$M$1" Then
            Range(cCell & Mid(ActiveCell.Address, 4, 8)).Select
            sMtArea = ActiveCell.FormulaR1C1
            Range(dCell & Mid(ActiveCell.Address, 4, 8)).Select
            sAcct = ActiveCell.FormulaR1C1
                sWorkID = sAcct & Format(Now(), "mmddyyyy")
            Range(eCell & Mid(ActiveCell.Address, 4, 8)).Select
            sBillCode = ActiveCell.FormulaR1C1
            Range(lCell & Mid(ActiveCell.Address, 4, 8)).Select
            sAddress = ActiveCell.FormulaR1C1
            Range(nCell & Mid(ActiveCell.Address, 4, 8)).Select
            sCity = ActiveCell.FormulaR1C1
            Range(oCell & Mid(ActiveCell.Address, 4, 8)).Select
            sState = ActiveCell.FormulaR1C1
            Range(pCell & Mid(ActiveCell.Address, 4, 8)).Select
            sZip = ActiveCell.FormulaR1C1
            
            Windows(sWorkbookName2).Activate
            Range("A" & iRow).Select
            ActiveCell.FormulaR1C1 = sWorkID
            Range("B" & iRow).Select
            ActiveCell.FormulaR1C1 = "LABS"
            Range("C" & iRow).Select
            ActiveCell.FormulaR1C1 = sMarket
            Range("D" & iRow).Select
            ActiveCell.FormulaR1C1 = sTechID
            Range("E" & iRow).Select
            ActiveCell.FormulaR1C1 = Date
            Range("F" & iRow).Select
            ActiveCell.FormulaR1C1 = "Y"
            Range("G" & iRow).Select
            ActiveCell.FormulaR1C1 = "COL"
            Range("H" & iRow).Select
            ActiveCell.FormulaR1C1 = sBillCode
            Range("I" & iRow).Select
            ActiveCell.FormulaR1C1 = "1"
            Range("J" & iRow).Select
            ActiveCell.FormulaR1C1 = Date
            Range("K" & iRow).Select
            ActiveCell.FormulaR1C1 = Date
            Range("M" & iRow).Select
            ActiveCell.FormulaR1C1 = sScanSerial
            Range("N" & iRow).Select
            ActiveCell.FormulaR1C1 = sAcct
            Range("O" & iRow).Select
            ActiveCell.FormulaR1C1 = sAddress
            Range("P" & iRow).Select
            ActiveCell.FormulaR1C1 = sCity
            Range("Q" & iRow).Select
            ActiveCell.FormulaR1C1 = sState
            Range("R" & iRow).Select
            ActiveCell.FormulaR1C1 = sZip
            Range("U" & iRow).Select
            ActiveCell.FormulaR1C1 = sMtArea
        Else
            ' If serial number was not found input Found Box"
            Beep
            Windows(sWorkbookName2).Activate
            Range("B" & iRow).Select
            ActiveCell.FormulaR1C1 = "LABS"
            Range("C" & iRow).Select
            ActiveCell.FormulaR1C1 = sMarket
            Range("D" & iRow).Select
            ActiveCell.FormulaR1C1 = sTechID
            Range("E" & iRow).Select
            ActiveCell.FormulaR1C1 = Date
            Range("F" & iRow).Select
            ActiveCell.FormulaR1C1 = "Y"
            Range("G" & iRow).Select
            ActiveCell.FormulaR1C1 = "COL"
            Range("J" & iRow).Select
            ActiveCell.FormulaR1C1 = Date
            Range("K" & iRow).Select
            ActiveCell.FormulaR1C1 = Date
            Range("M" & iRow).Select
            ActiveCell.FormulaR1C1 = sScanSerial
            Range("N" & iRow).Select
            ActiveCell.FormulaR1C1 = "Found Box"
        End If
        'ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
        'ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("N1:N1"), _
        '    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        'With ActiveWorkbook.Worksheets("Sheet1").Sort
        '    .SetRange Range("A:U")
        '    .Header = xlYes
        '    .MatchCase = False
        '    .Orientation = xlTopToBottom
        '    .SortMethod = xlPinYin
        '    .Apply
        'End With
        Columns("A:U").Select
        Columns("A:U").EntireColumn.AutoFit
        Range("A" & iRow & ":U" & iRow).Select
        iRow = iRow + 1
ReenterB:
        sScanSerial = InputBox("Scan or type equipment serial number", "Serial Number Processor")
        If StrPtr(sScanSerial) = 0 Then
            Windows(sWorkbookName2).Activate
        Else
            sScanSerial = Replace(sScanSerial, "*", "")
            If Len(Trim(sScanSerial)) < 5 And Len(Trim(sScanSerial)) > 0 Then
                Beep
                MsgBox "Serial numbers need to be at least 5 characters.", vbOKOnly, "Illegal entry error"
                GoTo ReenterB
            End If
        End If
    Wend
End Sub
Function FileOrDirExists(PathName As String) As Boolean
    Dim iTemp As Integer
    On Error Resume Next
    iTemp = GetAttr(PathName)
    Select Case Err.Number
        Case Is = 0
            FileOrDirExists = True
        Case Else
            FileOrDirExists = False
    End Select
    On Error GoTo 0
End Function
Function IsWbOpen(wbName As String) As String
    Dim i As Long
    IsWbOpen = ""
    For i = Workbooks.Count To 1 Step -1
        If InStr(1, Workbooks(i).Name, wbName) > 0 Then
            IsWbOpen = Workbooks(i).Name
            Exit For
        End If
    Next
End Function

Open in new window

So this is where you create the new workbook?
Workbooks.Add

Open in new window

If it is then you can easily change that line of code to create a new workbook from a template that already has the code in it.

All you need to do is use the. Template argument of the Add method.

For example.
Workbooks.Add Template:="C:\PathToTemplate\NameOfTheTemplateWorkbookThatAlreadyHasTheCodeInIt.xlsm"

Open in new window

OK added this at the end and the results was...it just opened the template...it did not add it to the new workbook that I already had opened.
Workbooks.Add Template:="C:\Users\Jimi\AppData\Roaming\Microsoft\Templates\BrightHouse_Item_Code_Reference.xltm"

Open in new window

What new workbook are you talking about?

Are you manually creating a new workbook?
Yes
I am taking 3 files that are emailed to me...I save these. Now I make 1 NEW workbook from all 3 files...merged workbook.
With this workbook open I am running the FORMATTING macro on it.
Sorry, you've lost me.

What code so you want to run on this newly created workbook, what code do you want to add to it, and why do you want to add that code to the new workbook?
ASKER CERTIFIED SOLUTION
Avatar of Joe Howard
Joe Howard
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
For the above code to work you must add a reference (from within the Visual Basic Editor) Tools>References: Microsoft Visual Basic for Applications Extensibility 5.3 library
Thanks
How do you make this new workbook, do you use a macro? If so, can you post that macro please?