Hi,
I have created a macro but puzzled on how to apply with three command buttons ( for neat look ).
cmd button1: browses the main raw data file.
cmd button2: vlookup data file for the main file.
cmd button3: Run the macro on the main raw data file from cmd button1.
your comments will be much helpful.. thanks. the code is as below.
I have created a macro but puzzled on how to apply with three command buttons ( for neat look ).
cmd button1: browses the main raw data file.
cmd button2: vlookup data file for the main file.
cmd button3: Run the macro on the main raw data file from cmd button1.
your comments will be much helpful.. thanks. the code is as below.
VBA Code:
Sub Macro4()
'
' Macro4 Macro
'
'
Cells.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
With Selection.Font
.Name = "Calibri"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Rows("1:1").Select
Selection.Font.Bold = True
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
Columns("N:N").Select
Selection.TextToColumns Destination:=Range("N1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
'
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
Columns("Q:S").Select
Selection.Insert Shift:=xlToRight
Range("Q1") = "Concantenate"
Range("R1") = "Delivery Plan"
Range("S1") = "Last Week Comments"
Range("Q2").Select
ActiveCell.FormulaR1C1 = "=RC[-16]&RC[-9]&RC[-7]"
Range("S2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'[Last Week.xlsx]Sheet1'!C1:C2,2,0)"
Range("R2").Select
ActiveCell.FormulaR1C1 = _
"=IFS(RC22=""YBWR"",""What"",ISNUMBER(RC25),""Fully Delivered"",RC19=""Billable Only"",""BILLABLE ONLY"",AND(ISBLANK(RC25),NOT(ISBLANK(RC27))),""Under shipment"",AND(ISBLANK(RC25),ISBLANK(RC27),ISNUMBER(RC14)),""Under packing"",AND(ISBLANK(RC25),ISBLANK(RC27),ISBLANK(RC14)),TEXT(WEEKNUM(RC23),""W00""))"
Range("P3").Select
Selection.End(xlDown).Select
Range("Q8833:S8833").Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Cells.Select
Range("Q8833").Activate
Selection.Columns.AutoFit
With Cells
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=($R1=""What"")"
With .FormatConditions(.FormatConditions.Count)
.SetFirstPriority
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 12173758
.TintAndShade = 0
End With
StopIfTrue = False
End With
End With
With Cells
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=($R1=""Fully Delivered"")"
With .FormatConditions(.FormatConditions.Count)
.SetFirstPriority
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 5691552
.TintAndShade = 0
End With
StopIfTrue = False
End With
End With
With Cells
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=($R1=""under shipment"")"
With .FormatConditions(.FormatConditions.Count)
.SetFirstPriority
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 3774674
.TintAndShade = 0
End With
StopIfTrue = False
End With
End With
With Cells
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=($R1=""under packing"")"
With .FormatConditions(.FormatConditions.Count)
.SetFirstPriority
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 15793920
.TintAndShade = 0
End With
StopIfTrue = False
End With
End With
Sheets(Array("Sheet2", "Sheet3")).Select
Sheets("Sheet3").Activate
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Range("A1").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
Range("A1:A8837"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$A$1:$BE$8837").AutoFilter Field:=1
'Declare Variables
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Dim pvtfield As PivotField
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Sheet1")
'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="PivotTable")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")
'Insert Row Fields
With ActiveSheet.PivotTables("PivotTable").PivotFields("Sold to name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Sales Document")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Customer purchase order number")
.Orientation = xlRowField
.Position = 3
End With
'Insert Column Fields
With ActiveSheet.PivotTables("PivotTable").PivotFields("Delivery Plan")
.Orientation = xlColumnField
.Position = 1
End With
'Insert Data Field
With ActiveSheet.PivotTables("PivotTable").PivotFields("SO Net value")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "#,##0"
.Name = " Sum SO Net value "
End With
'classic and expand/collapse button removal
Range("C7").Select
With ActiveSheet.PivotTables("PivotTable")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
Range("B4").Select
ActiveSheet.PivotTables("PivotTable").ShowDrillIndicators = False
'Format Pivot
TableActiveSheet.PivotTables("PivotTable").ShowTableStyleRowStripes = TrueActiveSheet.PivotTables("PivotTable").TableStyle2 = "PivotStyleMedium9"
End Sub
