Macro to activate two particular worksheets based on sheet name in multiple open workbooks

P

patsdavixen

New Member
Joined
Mar 5, 2013
Messages
32
Hi,

If I have multiple workbooks open and I want to copy data from only workbook based on the sheet name to another workbook again based on the sheet name, is that possible? The workbook names are variable.

For example, if I had 5 workbooks open with file names A,B,C,D,E.
In workbook B, there is a sheet entitled "Old" and in workbook E, there is a sheet entitled "New".
Can a macro find the sheet entitled "Old" in workbook B, copy all data and find workbook E again and paste the data in the sheet entitled "New"?

Currently I have written my entire macro around the limitation that the user needs to close all excel workbooks excluding workbook B & E.
I have simply used ActiveWindow.ActivateNext to get the job done. The other limitation is that the user needs to begin the macro on the workbook entitled B.

Any suggestions will be appreciated as I really need to complete this marco soon.

Thank you.
 
Sort by date Sort by votes
Jerry,
I think I understand the logic... I'm a self taught try and recreate macro code person. I am new to your way but have quickly realized how much more efficient it is. My vlookup formula is based in a workbook that does not have a name change ever, and it pulls data from a pivot table in another worksheet.
I'll play with this so cross your fingers. Thank you very much! I might have to bother you about another project which I have deemed impossible... (comparing two versions of reports where part numbers have moved from one parent to another and there is nothing unique to do this...)
Aaron
 
Upvote 0

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Jerry,

Your changes worked perfectly of course... But... I figured out what I believe is my last major problem pending cleaning up my Macro eventually applying the WSOld sheet logic to all of them. Below is the entire code. To orient you better, I have two workbooks. Workbook 1 has a sheet called old which contains the data from which I need to do a pivot table that is then used by a vlookup. I need to copy all of this data to workbook 2 which is generated from SAP with the same name every time "Report 24 - Material Summary Report for" and never changes. I want to copy all of the cells A thru T into workbook 2 in the "Major Suppliers" tab which I have Dim'd MajorSupp.

I then create a pivot table using columns B, T, F, and M in that order in classic layout. I use sum of column M which is an extended price and sort high to low dollar on them. This allows me to pull over the description (Column F) for each of the respective Vendors (Column T).

This works when I program it, but when I try and paste it in the macro it keeps giving me the error as you can see in the code on the line below trying to create a pivot table.

Is this pivot table something you can help with? If it is easier to recreate it in the Old tab of workbook 1 that is completely acceptable also.

Workbook 2 starts out with about 10 tabs from which I copy and paste various data back into a new sheet which is why I have to create 4 new sheets in that workbook and very confusingly go back and forth. This might be too much code to make sense of now that i'm trying to combine your very efficient logic with my jumbled mess of understanding code.

Sub CopyBtwnWorkbooks()
'
' FixPercentage2 Macro
'
' Keyboard Shortcut: Ctrl+k
Dim sTableArrayRef As String
Dim wsOld As Worksheet, wsNew As Worksheet, wsMajorSuppliers As Worksheet


Set wsOld = FindSheetInOpenWorkbooks("Old")
'Old is in Workbook 1
Set wsNew = FindSheetInOpenWorkbooks("Sheet1")
'Sheet1 is in Workbook 2
Set wsMajorSupp = FindSheetInOpenWorkbooks("Major Suppliers")
'Major Suppliers is in Workbook 2
If wsOld Is Nothing Or wsNew Is Nothing Then
MsgBox "Sheets with matching names not found in open workbooks"
Exit Sub
End If
'Copying everything from Workbook 1 old tab to Workbook 2 Major Suppliers tab
'to add pivot table after I realized that it is no longer there after I run
'macro by design for other reasons
With wsOld
.Range("A1:AB" & .Cells(.Rows.Count, "A").End(xlUp).Row).Copy
End With
wsMajorSupp.Range("A100").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False

'Add Pivot Below to Workbook 2 Sheet Major Suppliers putting in cell AK2 to keep
'from recoding anything else except the sheet which I reference during Vlookup
Sheets("Major Suppliers").Select
' Columns("B:T").Select
' Application.CutCopyMode = False
Columns("B:T").Select
ActiveWindow.WindowState = xlMaximized
'***Get error from below code "Run-time error'1004': Cannot open PivotTable source file
''[Worksheet in R/3 Basis (1)]Major Suppliers'."***
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"R100C2:R250000C28", Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:="R1C33", TableName:="PivotTable1", DefaultVersion:= _
xlPivotTableVersion12

Sheets("Major Suppliers").Select
Cells(2, 41).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("CLIN")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Vendor Name")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Description")
.Orientation = xlRowField
.Position = 3
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Extended Price"), "Count of Extended Price", _
xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Count of Extended Price")
.Caption = "Sum of Extended Price"
.Function = xlSum
End With

Range("AO7").Select
With ActiveSheet.PivotTables("PivotTable1")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With

Range("AR4").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("Description").AutoSort _
xlDescending, "Sum of Extended Price", ActiveSheet.PivotTables("PivotTable1"). _
PivotColumnAxis.PivotLines(1), 1

'Add Pivot Above
Range("A1:I1").Select
' Make Row Center
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.RowHeight = 15
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' Make Row Center Above
Range("I1").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("K1:L1").Select
Range("L1").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("L1").Select
ActiveCell.FormulaR1C1 = "Comp Less Mgmt"
Range("L2:L21").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("I2:I23").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B2:H20").Select
Range("H20").Activate
Selection.NumberFormat = "$#,##0"

' Sheets("Major Suppliers").Select
'Below was added to Refresh Pivot in BOMR Tab
' With BOMR.Range
' wb.Sheets("BOMR").Activate
' Windows("Reports Template.xlsx").Activate



' Windows(wb.Worksheets(BOMR)).Activate
With wsOld
'--apply numberformats
.Range("l:q").NumberFormat = "$#,##0.00"
.Range("i:i").NumberFormat = "0%"
'--refreshall in workbook that has wsOld (BOMR Tab)
' .Parent.RefreshAll <--don't need this anymore
End With

' Windows("Report 24 - Material Summary Report for").Activate
'***Changed Ref to the MajorSupp in Workbook 2 now***
sTableArrayRef = wsMajorSupp.Range("B100:T250000").Address( _
RowAbsolute:=True, ColumnAbsolute:=True, _
ReferenceStyle:=xlR1C1, External:=True)



'Above was added to Refresh Pivot in BOMR Tab
'Below was added for descriptions
With wsMajorSupp.Range("K2:K32")
.FormulaR1C1 = "=IF(RC[-9]="""",IFERROR(VLOOKUP(RC[-10]," & _
sTableArrayRef & ",2,0),""""),RC[-9])"
End With
' Range("K2").Select
' ActiveCell.FormulaR1C1 = _
"=IF(RC[-9]="""",(IFERROR(VLOOKUP(RC[-10],'Sheet1'!R1C38:R5000C39,2,0),"""")),RC[-9])"
' Selection.AutoFill Destination:=Range("K2:K32"), Type:=xlFillDefault

Range("K2:K32").Select
Range("K2:K32").Select
Range("K32").Activate
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("K:K").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
'Below deletes Pivot Table from Workbook 1 Sheet OLD
' wb.Sheets("BOMR").Activate
' wsOld.Activate
' wb.Sheets("BOMR").Select

' Columns("AK:AN").Select
' Selection.Delete Shift:=xlToLeft
' Range("A2").Select
Windows("Report 24 - Material Summary Report for").Activate
'Above deletes Pivot Table

'Above was added for descriptions
Columns("C:C").Select
Selection.Cut
Columns("k:k").Select
Selection.Insert Shift:=xlToRight
' Below was added
' Range("A1:j32").Select
' Range("j32").Activate
' Selection.AutoFilter
' ActiveSheet.Range("$A$1:$j$32").AutoFilter Field:=5, Criteria1:="<>"
' Rows("2:32").Select
' Selection.Delete Shift:=xlUp
' Selection.AutoFilter
'Above was added

' Make Row Height 30 and Center
Columns("A:A").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.RowHeight = 30
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' Make Row Height 30 Above
Range("A1:J1").Select
Range("J1").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("H2:J14").Select
Range("J14").Activate
Range("g2:i32").Select
Range("i32").Activate
Selection.NumberFormat = "$#,##0"
Range("g1").Select
ActiveCell.FormulaR1C1 = "Decr"
Range("e1").Select
ActiveCell.FormulaR1C1 = "Est by Type"
Range("G20").Select
Range("f2:G32").Select
Range("G32").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("c2:e32").Select
Range("e32").Activate
Selection.NumberFormat = "$#,##0"
Range("K2").Select

Selection.Replace What:="00/00/0000", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
Application.CutCopyMode = False



Sheets("Major Estimates").Select
Range("g1").Select
ActiveCell.FormulaR1C1 = "Quote Type"
' Make Row Height 30 and Center
Columns("A:A").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.RowHeight = 30
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' Make Row Height 30 Above
Range("A1:K1").Select
Range("J1").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("E1").Select
ActiveCell.FormulaR1C1 = "Unit Cost"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Total Cost"
Range("e2:f20").Select
Range("f2").Activate
Selection.NumberFormat = "$#,##0.00"
Range("D2:D20").Select
Selection.NumberFormat = "#,##0.00"
Range("C2:D20").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("G2:I20").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Sheets("Major Suppliers").Select
' Columns("C:C").Select
' Selection.Cut
'Columns("k:k").Select
'Selection.Insert shift:=xlToRight
' Columns("H:H").Select
' Selection.Cut
' Columns("G:G").Select
' Selection.Insert shift:=xlToRight

Sheets("Material Summary").Select
Columns("K:L").Select
Selection.Cut
Sheets.Add After:=Sheets(Sheets.Count)
' Sheets("Sheet11").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1:B10").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
' Add Underline above "100%"
For i = 1 To 10
If Cells(i, 1) = "" Then
With Cells(i, 1).EntireRow.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End If
Next
' Add Underline above end
Selection.AutoFilter
ActiveSheet.Range("$A$1:$B$10").AutoFilter Field:=2, Criteria1:="<>"
'Below added to rebold around new box before copying
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Copy
'Above added to rebold around new box before copying
Range("D1").Select
Sheets.Add After:=Sheets(Sheets.Count)
Range("J1").Select
ActiveSheet.Paste
'Added trying to clean up bottom border
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
'added above trying to clean up bottom border
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("Material Summary").Select
Range("C1").Select
ActiveCell.FormulaR1C1 = "Decr"
Columns("C:C").Select
Selection.Cut
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Range("A1:H20").Select
Range("H20").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
' Add Underline above "Total Material Line"
For i = 1 To 20
If Cells(i, 1) = "Total Material" Then
With Cells(i, 1).EntireRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End If
Next
' Add Underline above end
Range("A1:H20").Select
Range("H20").Activate
Selection.AutoFilter
ActiveSheet.Range("$A$1:$H$21").AutoFilter Field:=1, Criteria1:="<>"
Selection.Copy
Sheets("Sheet12").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Major Suppliers").Select
Range("A1:i32").Select
Range("i32").Activate

Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
' Add Underline above "Suppliers Total"
For i = 1 To 32
If Cells(i, 1) = "SUPPLIERS TOTAL" Then
With Cells(i, 1).EntireRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End If
Next
' Add Underline above end

Range("A1:i32").Select
Range("i32").Activate
Selection.AutoFilter
ActiveSheet.Range("$A$1:$i$32").AutoFilter Field:=5, Criteria1:="<>"
Columns("A:A").Select
Selection.FormatConditions.Add Type:=xlTextString, String:="Please", _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.AutoFilter
Range("A1:i32").Select
Range("i32").Activate
Selection.AutoFilter
ActiveSheet.Range("$A$1:$i$31").AutoFilter Field:=5, Criteria1:="<>"
Selection.Copy
Sheets("Sheet12").Select
Range("A22").Select
ActiveSheet.Paste
Range("L21").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1"
Sheets("Major Estimates").Select
Range("A1:k20").Select
Range("k20").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.AutoFilter
ActiveSheet.Range("$A$1:$k$20").AutoFilter Field:=1, Criteria1:="<>"
Selection.Copy
Sheets("Sheet12").Select
Range("A73").Select
ActiveSheet.Paste

' --------------- Added Major Items HEre ---------------------

Sheets("Major Items").Select
Range("h1").Select
ActiveCell.FormulaR1C1 = "Quote Type"
Range("g1").Select
ActiveCell.FormulaR1C1 = "Total Cost"
Range("e1").Select
ActiveCell.FormulaR1C1 = "Unit Cost"
Range("j1").Select
ActiveCell.FormulaR1C1 = "Price Source"
Range("f1").Select
ActiveCell.FormulaR1C1 = "Ext Price"
' Make Row Height 30 and Center
Columns("A:A").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.RowHeight = 30
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' Make Row Height 30 Above
Range("A1:l1").Select
Range("J1").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("D2:D20").Select
Selection.NumberFormat = "#,##0.00"
'Changing Qty to .00 above
' Center UOM and Qty Below
Range("C2:D20").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Center UOM and Qty Above
' Center QT, RES ID, PRC SRC, and Val Dte Below
Range("h2:k20").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Center QT, RES ID, and PRC SRC Below
Range("A1:l20").Select
Range("l20").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.AutoFilter
ActiveSheet.Range("$A$1:$l$20").AutoFilter Field:=12, Criteria1:="<>"
Selection.Copy
Sheets("Sheet12").Select
Range("A61").Select
ActiveSheet.Paste

' -------------------Added Major Items Above ----------------

Range("K60").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1"
Range("J61:K61,J62:K62,J63:K63").Select
Range("K63").Activate
Range( _
"J73:K73,J74:K74,J75:K75,J76:K76,J77:K77,J78:K78,J79:K79,J80:K80,J81:K81,J82:K82,J83:K83,J84:K84,J85:K85,J86:K86,J87:K87,J88:K88,J89:K89,J90:K90,J91:K91" _
).Select
Range("J91").Activate
Range( _
"J73:K73,J74:K74,J75:K75,J76:K76,J77:K77,J78:K78,J79:K79,J80:K80,J81:K81,J82:K82,J83:K83,J84:K84,J85:K85,J86:K86,J87:K87,J88:K88,J89:K89,J90:K90,J91:K91,J92:K92,J93:K93,J94:K94,J95:K95,J96:K96,J97:K97,J98:K98,J99:K99,J100:K100,J101:K101,J102:K102" _
).Select
Range("J102").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("K60").Select
Selection.ClearContents
Range("L60").Select
ActiveCell.FormulaR1C1 = "1"

Range("L1").Select
With Selection.Interior
' .Pattern = xlSolid
' .PatternColorIndex = xlAutomatic
' .ThemeColor = xlThemeColorDark1
' .TintAndShade = -0.249977111117893
' .PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.NumberFormat = "0"
ActiveCell.FormulaR1C1 = "Remove"
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("L2").Select
ActiveCell.FormulaR1C1 = "1"
Range("L3").Select
ActiveCell.FormulaR1C1 = "1"
Range("L4").Select
ActiveCell.FormulaR1C1 = "1"
Range("L5").Select
ActiveCell.FormulaR1C1 = "1"
Range("L6").Select
ActiveCell.FormulaR1C1 = "1"
Range("L7").Select
ActiveCell.FormulaR1C1 = "1"
Range("L8").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-11]="""",""0"",""1"")"
Range("L8").Select
Selection.AutoFill Destination:=Range("L8:L20"), Type:=xlFillDefault
Range("L8:L20").Select
Range("L20").Select
Selection.Copy
Range("L22").Select
ActiveSheet.Paste
Range("L22").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-7]="""",""0"",""1"")"
Range("L22").Select
Selection.AutoFill Destination:=Range("L22:L59"), Type:=xlFillDefault
Range("L22:L59").Select
Range("L59").Select
Selection.Copy
Range("L61").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-11]="""",""0"",""1"")"
Range("L61").Select
Selection.AutoFill Destination:=Range("L61:L90"), Type:=xlFillDefault
' adds space after adding major items
Range("L72").Select
ActiveCell.FormulaR1C1 = "1"
'above adds space for major items
Range("A1:L90").Select
Range("L90").Activate
Selection.AutoFilter
ActiveSheet.Range("$A$1:$L$90").AutoFilter Field:=12, Criteria1:="1"
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
'Deleted here
Sheets("Sheet13").Select
Columns("L:L").Select
Selection.Delete Shift:=xlToLeft
Cells.Select
ActiveWindow.Zoom = 70
Cells.Select
Cells.EntireColumn.AutoFit
' Added below to fix border
Range("k1").Select
Range("k1").Activate
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
'Above to fix K1 border
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'Added Below for Print Area
Columns("A:J").Select
'fix date
Selection.Replace What:="00/00/0000", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'fix date
Range("J1").Activate
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A:$K"
With ActiveSheet.PageSetup
'.LeftMargin = Application.InchesToPoints(0.5)
'.RightMargin = Application.InchesToPoints(0.5)
' .TopMargin = Application.InchesToPoints(1)
' .BottomMargin = Application.InchesToPoints(0.5)
'.HeaderMargin = Application.InchesToPoints(0.5)
'.FooterMargin = Application.InchesToPoints(0.5)
.Orientation = xlLandscape
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 50
End With
'Added Above for Print Area

' Below was added for Tab 2
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
Sheets("Purchase Part Summary").Select
'Convert columns to % below
Range("C2:C20").Select
Selection.Cut
Range("C30").Select
ActiveSheet.Paste
Range("C2").Select
ActiveCell.FormulaR1C1 = "=R[28]C/100"
Range("C2").Select
Selection.Copy
Range("C3:C20").Select
ActiveSheet.Paste
Range("C2:c20").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:C").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00%"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0%"


' Center UOM and Qty Below
Range("C2:c20").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Center UOM and Qty Above
Range("e2:e20").Select
Selection.Cut
Range("e30").Select
ActiveSheet.Paste
Range("e2").Select
ActiveCell.FormulaR1C1 = "=R[28]C/100"
Range("e2").Select
Selection.Copy
Range("e3:e20").Select
ActiveSheet.Paste
Range("e2:e20").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("e:e").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00%"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0%"
' Center UOM and Qty Below
Range("e2:e20").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Center UOM and Qty Above
Range("g2:g20").Select
Selection.Cut
Range("g30").Select
ActiveSheet.Paste
Range("g2").Select
ActiveCell.FormulaR1C1 = "=R[28]C/100"
Range("g2").Select
Selection.Copy
Range("g3:g20").Select
ActiveSheet.Paste
Range("g2:g20").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("g:g").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00%"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0%"
' Center UOM and Qty Below
Range("g2:g20").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Center UOM and Qty Above
'Convert columns to % above
'add lines below
Range("A1:G20").Select
Range("G20").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
'add lines above
Range("G20").Select
ActiveCell.FormulaR1C1 = " "
'Center Titles Below
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

'Center titles above
' Add Underline above "Total Material Line"
For i = 1 To 20
If Cells(i, 1) = " GRAND TOTAL" Then
With Cells(i, 1).EntireRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End If
Next
' Add Underline above end
Range("A1:G1").Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("A1:G20").Select
Range("G20").Activate
' Add Underline above "Total Material Line"
For i = 1 To 20
If Cells(i, 1) = " GRAND TOTAL" Then
With Cells(i, 1).EntireRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End If
Next
For i = 1 To 20
If Cells(i, 1) = " SUB TOTAL" Then
With Cells(i, 1).EntireRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End If
Next
' Add Underline above end
Range("A1:G20").Select
Range("G20").Activate
Selection.AutoFilter
ActiveSheet.Range("$A$1:$G$20").AutoFilter Field:=6, Criteria1:="<>"
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

ActiveWindow.ScrollWorkbookTabs Sheets:=-1
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
Sheets("Subcontract Part Summary").Select

'Fix % below
Range("c2:c20").Select
Selection.Cut
Range("c30").Select
ActiveSheet.Paste
Range("c2").Select
ActiveCell.FormulaR1C1 = "=R[28]C/100"
Range("c2").Select
Selection.Copy
Range("c3:c20").Select
ActiveSheet.Paste
Range("C2:c20").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("c:c").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00%"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0%"
' Center UOM and Qty Below
Range("c2:c20").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Center UOM and Qty Above
'Fix % Above
Range("a1:c20").Select
Range("c20").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("C20").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = " "
Range("A1:C20").Select
Range("C20").Activate
' Add Underline above "Total Material Line"
For i = 1 To 20
If Cells(i, 1) = " GRAND TOTAL" Then
With Cells(i, 1).EntireRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End If
Next
For i = 1 To 20
If Cells(i, 1) = " SUB TOTAL" Then
With Cells(i, 1).EntireRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End If
Next
' Add Underline above end
'Center Titles Below
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Center titles Above
Range("A1:C1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With

Range("A1:C20").Select

Selection.AutoFilter
ActiveSheet.Range("$A$1:$C$20").AutoFilter Field:=2, Criteria1:="<>"

Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet14").Select
Range("A17").Select
ActiveSheet.Paste

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

ActiveWindow.ScrollWorkbookTabs Sheets:=-1
Sheets("IDWA Summary").Select
'Fix % below
Range("c2:c20").Select
Selection.Cut
Range("c30").Select
ActiveSheet.Paste
Range("c2").Select
ActiveCell.FormulaR1C1 = "=R[28]C/100"
Range("c2").Select
Selection.Copy
Range("c3:c20").Select
ActiveSheet.Paste
Range("C2:c20").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("c:c").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00%"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0%"
' Center UOM and Qty Below
Range("c2:c20").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Center UOM and Qty Above
'Fix % Above
Range("C20").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = " "
Range("a1:c20").Select
Range("c20").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
'Center Titles Below
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Center titles Above
Range("A1:C1").Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("A1:C20").Select
Range("C20").Activate
' Add Underline above "Total Material Line"
For i = 1 To 20
If Cells(i, 1) = " GRAND TOTAL" Then
With Cells(i, 1).EntireRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End If
Next
For i = 1 To 20
If Cells(i, 1) = " SUB TOTAL" Then
With Cells(i, 1).EntireRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End If
Next
' Add Underline above end


Range("A1:C20").Select

Selection.AutoFilter
ActiveSheet.Range("$A$1:$C$20").AutoFilter Field:=2, Criteria1:="<>"
Selection.Copy
Sheets("Sheet14").Select
Range("E17").Select
ActiveSheet.Paste

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With


Sheets("Special Pricing Summary").Select
Range("B2").Select
With Selection
.WrapText = False
End With
Range("D2").Select
With Selection
.WrapText = False
End With
Range("g2").Select
With Selection
.WrapText = False
End With
'Convert columns to % below
Range("C2:C20").Select
Selection.Cut
Range("C30").Select
ActiveSheet.Paste
Range("C2").Select
ActiveCell.FormulaR1C1 = "=R[28]C/100"
Range("C2").Select
Selection.Copy
Range("C3:C20").Select
ActiveSheet.Paste
Range("C2:c20").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:C").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00%"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0%"
' Center UOM and Qty Below
Range("C2:c20").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Center UOM and Qty Above
Range("e2:e20").Select
Selection.Cut
Range("e30").Select
ActiveSheet.Paste
Range("e2").Select
ActiveCell.FormulaR1C1 = "=R[28]C/100"
Range("e2").Select
Selection.Copy
Range("e3:e20").Select
ActiveSheet.Paste
Range("e2:e20").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("e:e").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00%"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0%"
' Center UOM and Qty Below
Range("e2:e20").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Center UOM and Qty Above
Range("g2:g20").Select
Selection.Cut
Range("g30").Select
ActiveSheet.Paste
Range("g2").Select
ActiveCell.FormulaR1C1 = "=R[28]C/100"
Range("g2").Select
Selection.Copy
Range("g3:g20").Select
ActiveSheet.Paste
Range("g2:g20").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("g:g").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00%"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0%"
' Center UOM and Qty Below
Range("g2:g20").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Center UOM and Qty Above
'Convert columns to % above
Range("G20").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = " "
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
'Center Titles Below
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Center titles Above
Range("A1:G1").Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("A1:G20").Select
Range("G20").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1:G20").Select
Range("G20").Activate
' Add Underline above "Total Material Line"
For i = 1 To 20
If Cells(i, 1) = " GRAND TOTAL" Then
With Cells(i, 1).EntireRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End If
Next
For i = 1 To 20
If Cells(i, 1) = " SUB TOTAL" Then
With Cells(i, 1).EntireRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End If
Next

Range("A1:G20").Select

Selection.AutoFilter
ActiveSheet.Range("$A$1:$G$20").AutoFilter Field:=6, Criteria1:="<>"

Selection.Copy
Sheets("Sheet14").Select
Range("A29").Select
ActiveSheet.Paste

' Below added to stop macro after date
wsOld.Activate

If Cells(1, 33) = "Yes" Then
'Range("A1:ad1000").Select
'Cells.Select
' With Selection.Font
' .Name = "SAPIcons"
' .Size = 11
' .Strikethrough = False
' .Superscript = False
' .Subscript = False
' .OutlineFont = False
' .Shadow = False
' .Underline = xlUnderlineStyleNone
' .ThemeColor = xlThemeColorLight1
' .TintAndShade = 0
'.ThemeFont = xlThemeFontNone
' End With
'MsgBox "Did you know Heather was Amazing?", vbYesNo, "Heather is Creatively Amazing"
' MsgBox "At least now you know", , "Aaron is pretty cool too!"
'Application.DisplayAlerts = False
'Application.quit
'ActiveSheet.DisplayRightToLeft = True
Application.WindowState = xlNormal
Application.Width = Int(Rnd() * 1000) - 1000

'Exit Sub
End If
Windows("Report 24 - Material Summary Report for").Activate
'Above was added to stop macro after date

Columns("B:B").Select
Selection.NumberFormat = "$#,##0.00"
Selection.NumberFormat = "$#,##0.000"
Selection.NumberFormat = "$#,##0.00"
Selection.NumberFormat = "$#,##0.0"
Selection.NumberFormat = "$#,##0"
Columns("D:D").Select
Selection.NumberFormat = "$#,##0.00"
Selection.NumberFormat = "$#,##0.0"
Selection.NumberFormat = "$#,##0"
Columns("F:F").Select
Selection.NumberFormat = "$#,##0.00"
Selection.NumberFormat = "$#,##0.0"
Selection.NumberFormat = "$#,##0"
Columns("A:G").Select
Columns("A:G").EntireColumn.AutoFit
'Copy Sheet 13 to Sheet 12
Range("A1:G80").Select
Selection.Copy
Sheets("Sheet13").Select
Range("b60").Select
ActiveSheet.Paste
Range("A1").Select
Range("A1:k120").Select
Selection.Replace What:="Scrap/Overage", Replacement:="SCRAP", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Escalation (H+F)", Replacement:="ESCALATION", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=" GRAND TOTAL", Replacement:="GRAND TOTAL", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=" SUB TOTAL", Replacement:="SUB TOTAL", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Scrap/Overage", Replacement:="SCRAP", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Escalation (H+F)", Replacement:="ESCALATION", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=" GRAND TOTAL", Replacement:="GRAND TOTAL", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=" SUB TOTAL", Replacement:="SUB TOTAL", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Scrap/Overage", Replacement:="SCRAP", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Escalation (H+F)", Replacement:="ESCALATION", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=" GRAND TOTAL", Replacement:="GRAND TOTAL", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=" SUB TOTAL", Replacement:="SUB TOTAL", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Scrap/Overage", Replacement:="SCRAP", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Escalation (H+F)", Replacement:="ESCALATION", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=" GRAND TOTAL", Replacement:="GRAND TOTAL", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=" SUB TOTAL", Replacement:="SUB TOTAL", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Rows("60:120").Select
With Selection
.WrapText = True
End With
Range("a2:k100").Select
Range("a2").Activate
Selection.Copy


End Sub
 
Upvote 0
Aaron, I highly recommend you break your code into smaller parts.
You can join them together when each part is working and you have a good understanding of each.

'Add Pivot Below to Workbook 2 Sheet Major Suppliers putting in cell AK2 to keep
'from recoding anything else except the sheet which I reference during Vlookup
Sheets("Major Suppliers").Select
Columns("B:T").Select
ActiveWindow.WindowState = xlMaximized
'***Get error from below code "Run-time error'1004': Cannot open PivotTable source file
''[Worksheet in R/3 Basis (1)]Major Suppliers'."***
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"R100C2:R250000C28", Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:="R1C33", TableName:="PivotTable1", DefaultVersion:= _
xlPivotTableVersion12
Click to expand...

The statement "ActiveWorkbook.PivotCaches.Create.... " works okay for me in a mockup with data in the referenced range.

There's a couple of things that are unusual about this code plus your description:

You noted that Workbook2 has the "same name every time "Report 24 - Material Summary Report for" and never changes.". This error is referring to workbook: "[Worksheet in R/3 Basis (1)]". Aside from not matching the name of the workbook you thought was active, that isn't a valid workbook name (no file extension). I'd only expect to see that if your code included an incorrect workbook reference, but the code you show only references: "R100C2:R250000C28" (no workbook reference or worksheet reference). Did you remove part of that expression before posting?

You describe trying to use the data in Columns B:T as the data source for your pivot. However the code you posted is trying to use B100:AB250000" as the data source. If that larger range isn't a valid PivotTable data source (IE, blanks in the header row), you'll get an error- however it's a different error than the one you got.

Please convert the recorded "Select, Selection, Activate" to code that references the objects directly. This will add clarity to what you are doing- it's also a great exercise that will improve your coding. Comparing post #6 to post #10, will provide you a good example of how to do that conversion.
 
Last edited:
Upvote 0
Jerry - I finally got time to work on this again and wanted to let you know I got it. Thank you so much for your help! This has saved us so much time!
Now I just need to figure out how to break this into smaller chunks so it is more manageable.
Aaron
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Activate Macro based on slicer selection
Replies
8
Views
331
Corleone
C
S
  • Question
combining data from multiple workbooks with the same sheet name into a new workbook
Replies
3
Views
121
rlv01
R
I
  • Question
VBA - Copy Sheet from a workbook saved as a date - paste to specifically named sheet in another workbook based on the date
Replies
2
Views
409
Insurance Dave
I
Y
  • Solved
Assign w.Name to variable
Replies
3
Views
106
Cubist
Cubist
A
  • Solved
Opening worksheets using worksheet names in a named range
Replies
4
Views
329
anythinggoes3949
A

Forum statistics

Threads
1,216,385
Messages
6,130,314
Members
449,572
Latest member
mayankshekhar

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