A question on add-in and adjusting VBA code

A

amaclean

New Member
Joined
Nov 3, 2011
Messages
1
I have created a macro that does what I want it to do which is great. The problem now is that the workbook that this macro needs to run on changes name every week. This made me think of turning it into a add-in so I can run the macro regardless of the name of the workbook. So I have 2 starting questions.

1) What is necessary to make the add-in correctly address the workbook that I am launching the macro from? (The macro looks at 3 other workbooks and then creates the appropriate worksheets in the active workbook, or at least it did before it was an add-in)

2)How do I adjust the code in VBA to correctly adjust for the fact that the active workbook will have a different name every week? (I had the macro switch workbooks by name, the other 3 workbooks retain the same name)

I placed the code below.

Rich (BB code): 
Sub E_onhand()
'
' E_onhand Macro
' moves and pastes E02
'

'
    Windows("Pepboys.xls").Activate
    Columns("A:A").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A:$A").AutoFilter Field:=1, Criteria1:="E02"
    Columns("A:L").Select
    Selection.Copy
Dim wb As Workbook, x As String
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then x = wb.Name
Next wb
MsgBox "The other open workbook is named " & x & "." & vbCrLf & _
"Click OK to activate it."
Workbooks(x).Activate
    Sheets.Add
        ActiveSheet.Name = "E02"
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Wk#40").Select
    Range("M2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(RC[-8]),"""",VLOOKUP(RC[-8],'E02'!C6:C7,2))"
    Range("M2").Select
    Selection.AutoFill Destination:=Range("M2:M2000")
    Columns("M:M").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End Sub


Sub D_onhand()
'
' D_onhand Macro
' Pulls and pastes D01
'

'
    Range("N2").Select
    Windows("Pepboys.xls").Activate
    Columns("A:A").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A:$A").AutoFilter Field:=1, Criteria1:="D01"
    Columns("A:L").Select
    Selection.Copy
Dim wb As Workbook, x As String
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then x = wb.Name
Next wb
MsgBox "The other open workbook is named " & x & "." & vbCrLf & _
"Click OK to activate it."
Workbooks(x).Activate
    Sheets.Add
        ActiveSheet.Name = "D01"
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Wk#40").Select
    Range("N2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(RC[-9]),"""",VLOOKUP(RC[-9],'D01'!C6:C7,2))"
    Range("N2").Select
    Selection.AutoFill Destination:=Range("N2:N2000")
    Range("N:N").Select
    Columns("N:N").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End Sub


Sub J_onhand()
'
' J_onhand Macro
' Pulls J01 on hand
'
    Windows("Pepboys.xls").Activate
    Columns("A:A").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A:$A").AutoFilter Field:=1, Criteria1:="J01"
    Columns("A:L").Select
    Selection.Copy
Dim wb As Workbook, x As String
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then x = wb.Name
Next wb
MsgBox "The other open workbook is named " & x & "." & vbCrLf & _
"Click OK to activate it."
Workbooks(x).Activate
    Sheets.Add
        ActiveSheet.Name = "J01"
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Wk#40").Select
    Range("O2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(RC[-10]),"""",VLOOKUP(RC[-10],'J01'!C6:C7,2))"
    Range("O2").Select
    Selection.AutoFill Destination:=Range("O2:O2000")
    Columns("O:O").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End Sub


Sub Bosch_openorders()
'
' Bosch_openorders Macro
' Pulls Bosch open orders
'
    Windows("Customer Order 1.xls").Activate
    Columns("F:F").Select
    ActiveCell.FormulaR1C1 = "=TRIM(C[-2])"
    Range("F1").Select
    Selection.AutoFill Destination:=Range("F1:F7000")
    Range("F1:F7000").Select
    Columns("F:F").Select
    Selection.Copy
    Columns("D:D").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("A:H").Select
    Selection.Copy
Dim wb As Workbook, x As String
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then x = wb.Name
Next wb
MsgBox "The other open workbook is named " & x & "." & vbCrLf & _
"Click OK to activate it."
Workbooks(x).Activate
    Sheets.Add
        ActiveSheet.Name = "Bosch Open Orders"
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Wk#40").Select
    Range("K2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(RC[-6]),"""",VLOOKUP(RC[-6],'Bosch Open Orders'!C4:C5,2,))"
    Range("K2").Select
    Selection.AutoFill Destination:=Range("K2:K2000")
    Columns("K:K").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End Sub


Sub Replacer()
'
' Macro16 Macro
'

'
    Cells.Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub


Sub Workorder()
'
' Workorder Macro
' Cleans and transfers open work orders
'

'
    Windows("Open Work Order 1.xls").Activate
    Columns("M:N").Select
    Selection.Delete Shift:=xlToLeft
    Columns("M:M").Select
    ActiveCell.FormulaR1C1 = "=TRIM(C[-11])"
    Range("M1").Select
    Selection.AutoFill Destination:=Range("M1:M2000")
    Range("M1:M2000").Select
    Columns("M:M").Select
    Selection.Copy
    Columns("B:B").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("A:L").Select
    Selection.Copy
Dim wb As Workbook, x As String
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then x = wb.Name
Next wb
MsgBox "The other open workbook is named " & x & "." & vbCrLf & _
"Click OK to activate it."
Workbooks(x).Activate
    Sheets.Add
        ActiveSheet.Name = "Work Order"
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    'Creates Pivot Table
    
  Sheets.Add
        ActiveSheet.Name = "Pivot Order"
       Dim pt As PivotTable
       Dim strField As String
       Dim WSD As Worksheet
       Set WSD = Worksheets("Work Order")
       Dim PTOutput As Worksheet
       Set PTOutput = Worksheets("Pivot Order")
       Dim PTCache As PivotCache
       Dim PRange As Range

      ' Find the last row with data
      Dim finalRow As Long
      finalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row

      ' Find the last column with data
      Dim finalCol As Long
      finalCol = WSD.Cells(1, Application.Columns.Count).End(xlToLeft).Column

      ' Find the range of the data
      Set PRange = WSD.Cells(1, 1).Resize(finalRow, finalCol)
      Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange)
      
      ' Create the pivot table
     Set pt = PTCache.CreatePivotTable(TableDestination:=PTOutput.Cells(1, 1), _
     TableName:="SamplePivot")

      ' Define the layout of the pivot table

      ' Set update to manual to avoid recomputation while laying out
      pt.ManualUpdate = True

      ' Set up the row fields
      pt.AddFields RowFields:=Array( _
        "ITMID")

      ' Set up the data fields
      With pt.PivotFields("ORDQTY")
          .Orientation = xlDataField
          .Function = xlSum
          .Position = 1
      End With

    ' Now calc the pivot table
      pt.ManualUpdate = False
      
    'Now on to if vlookup function
    
    Sheets("Wk#40").Select
    Range("P2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(RC[-11]),"""",VLOOKUP(RC[-11],'Pivot Order'!C1:C2,2,))"
    Range("P2").Select
    Selection.AutoFill Destination:=Range("P2:P2000")
    Columns("P:P").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End Sub


Sub Master_macro()
'
' Master_macro Macro
' Runs all macros and 0 replaces
'

    Application.Run "'Pepboys macro book.xla'!Insert_columns"
    Application.Run "'Pepboys macro book.xla'!E_onhand"
    Application.Run "'Pepboys macro book.xla'!D_onhand"
    Application.Run "'Pepboys macro book.xla'!J_onhand"
    Application.Run "'Pepboys macro book.xla'!Bosch_openorders"
    Application.Run "'Pepboys macro book.xla'!Replacer"
    Application.Run "'Pepboys macro book.xla'!Workorder"
    Application.Run "'Pepboys macro book.xla'!Sum_macro"

'

End Sub


Sub Sum_macro()
'
' Sum_macro Macro
' fills in current domestic available
'

'
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-2]),SUM(RC[-5]:RC[-2])-RC[-7],"""")"
    Range("R2").Select
    Selection.AutoFill Destination:=Range("R2:R2000"), Type:=xlFillDefault

End Sub



Sub Insert_columns()
'
' Insert_columns Macro
' inserts columns and names
'

'
    Columns("K:K").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "BOSCH ID"
    With ActiveCell.Characters(Start:=1, Length:=8).Font
        .Name = "Arial"
        .FontStyle = "Bold Italic"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "BOSCH OPEN ORDERS"
    With ActiveCell.Characters(Start:=1, Length:=17).Font
        .Name = "Arial"
        .FontStyle = "Bold Italic"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "E02 OH"
    With ActiveCell.Characters(Start:=1, Length:=6).Font
        .Name = "Arial"
        .FontStyle = "Bold Italic"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "D01 OH"
    With ActiveCell.Characters(Start:=1, Length:=6).Font
        .Name = "Arial"
        .FontStyle = "Bold Italic"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "J01 OH"
    With ActiveCell.Characters(Start:=1, Length:=6).Font
        .Name = "Arial"
        .FontStyle = "Bold Italic"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "Open W/O"
    With ActiveCell.Characters(Start:=1, Length:=8).Font
        .Name = "Arial"
        .FontStyle = "Bold Italic"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("E1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("K1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("M1:P1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
You must log in or register to reply here.

Similar threads

P
  • Question
Help with Vba Code
Replies
3
Views
160
Coyotex3
C
N
  • Question
My code is suddenly really slow
Replies
1
Views
134
RobP
R
P
  • Solved
Loop Not Looping too Next Sheet
Replies
3
Views
241
Joe4
Joe4
L
  • Solved
VBA remove leading zeros
2
Replies
14
Views
965
Joe4
Joe4
L
  • Question
Variable Rows, Help Speeding Up
Replies
4
Views
318
kevin9999
K

Forum statistics

Threads
1,214,956
Messages
6,122,465
Members
449,085
Latest member
ExcelError

Share this page

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