vba macro with 3 command buttons

wells

New Member
Joined
Jan 9, 2020
Messages
24
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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.

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
 

Some videos you may like

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

wells

New Member
Joined
Jan 9, 2020
Messages
24
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have done that already. please read my requirements .. its different
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,849
You have posted one macro: Sub Macro4()

Have you assigned this macro to the desired button as described in the resource ?

If not .... why ?

If the posted macro is not the desired macro to be assigned to the macro ... please explain.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,473
Messages
5,596,356
Members
414,061
Latest member
JJSB

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
Top