Jimi Sherman
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
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
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
Couldn't you use a template workbook with the code already in it?
ASKER
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?
Also, why do you need this code in the workbook you are creating by merging the other workbooks?
ASKER
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.
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?
ASKER
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.
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
So this is where you create the new workbook?
All you need to do is use the. Template argument of the Add method.
For example.
Workbooks.Add
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"
ASKER
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"
What new workbook are you talking about?
Are you manually creating a new workbook?
Are you manually creating a new workbook?
ASKER
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.
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?
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
ASKER
Thanks
How do you make this new workbook, do you use a macro? If so, can you post that macro please?
Open in new window
This code creates the procedure:
Open in new window