How to apply a macro function with three command buttons ? I tried with below code.. but returns the macro applied on different sheet.
cmd button1: browses the main raw data file.
cmd button2: vlookup data file for the main raw data file.
cmd button3: Run the macro below function on the main raw data file.
your ideas will be much helpful.. thanks in advance.
Option Explicit
Sub currentZOE3()
'declare variable to store path
Dim Get_Path As String
Dim fileExplorer As FileDialog
Set fileExplorer = Application.FileDialog(msoFileDialogFilePicker)
'To allow or disable to multi select
fileExplorer.AllowMultiSelect = False
With fileExplorer
If .Show <> 0 Then
Get_Path = .SelectedItems(1)
End If
Worksheets("sheet1").Cells(3, 4).Value = Get_Path
End With
End Sub
Sub lastweekZOE3()
'declare variable to store path
Dim Get_Path As String
Dim fileExplorer As FileDialog
Set fileExplorer = Application.FileDialog(msoFileDialogFilePicker)
'To allow or disable to multi select
fileExplorer.AllowMultiSelect = False
With fileExplorer
If .Show <> 0 Then
Get_Path = .SelectedItems(1)
End If
Worksheets("sheet1").Cells(5, 4).Value = Get_Path
End With
End Sub
Sub Macro4()
'
' Macro4 Macro
'
'
Dim updWb As Workbook
Dim DSheet As Worksheet
Set updWb = Workbooks.Open(Worksheets("sheet1").Cells(3, 4).Value)
Set DSheet = updWb.Sheets("Sheet1")
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
Once you have the path of the file using the FileDialog
method.
You can use the below function to open that excel and update the contents of it's worksheets.
Dim updWb As Workbook, wSheet As Worksheet
Set updWb = Workbooks.Open("<path of the workbook to be updated>")
Set wSheet = updWb.Sheets("<sheet-name> or <sheet-index>")