Interpreting Excel Macro

A

asciijai

New Member
Joined
Apr 28, 2018
Messages
2
Dear Community,

I am an MBA Student and I am pretty new to the world of MS Excel Macros. Would greatly appreciate if somebody could help me interpret this code for me. What is it exactly doing ?

Sub D10_Common_Unique_NEW()
ActiveSheet.Shapes(Application.Caller).Name = "TheOneButt"
ActiveSheet.Shapes("TheOneButt").Select
Selection.Delete
ErrorNo = 999
ActiveSheet.Name = "Raw"
WB1 = Application.ActiveWorkbook.Name
Range("24:24").Select
If ActiveSheet.AutoFilterMode = True Then
Selection.AutoFilter
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Sort by date Sort by votes
Hi,
Code: 
[LEFT][COLOR=#333333][FONT=Verdana]Sub D10_Common_Unique_NEW()                                                        Name of the macro  [/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]    ActiveSheet.Shapes(Application.Caller).Name = "TheOneButt"                 Look for a shape called "TheOneButt" (can be an arrow, a photo...any object)[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]    ActiveSheet.Shapes("TheOneButt").Select                                              Select it (unnecessary step, I would have replace Select by delete)[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]    Selection.Delete                                                                                   Delete it [/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]    ErrorNo = 999                                                                                      Error management, that is a way to jump from one place to another in the macro depending on cases[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]    ActiveSheet.Name = "Raw"                                                                   Name of active sheet is "Raw"[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]    WB1 = Application.ActiveWorkbook.Name                                              and of the workbook WB1[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]    Range("24:24").Select                                                                          Select line 24[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]    If ActiveSheet.AutoFilterMode = True Then                                             if the filter is on[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]        Selection.AutoFilter                                                                          [COLOR=#222222][FONT=Verdana]set it up on line 24[/FONT][/COLOR] [/FONT][/COLOR][/LEFT]
 
Last edited:
Upvote 0
Hi Kalmoga,

Thank you for the quick response. But strangely the entire code of the macro was not pasted here and I had difficulties in interpreting the later part.This is the complete macro.. if you could help me understand it I would be grateful

Code: 
Sub D10_Common_Unique_NEW()
    ActiveSheet.Shapes(Application.Caller).Name = "TheOneButt"
    ActiveSheet.Shapes("TheOneButt").Select
    Selection.Delete
    ErrorNo = 999
    ActiveSheet.Name = "Raw"
    WB1 = Application.ActiveWorkbook.Name
    Range("24:24").Select
    If ActiveSheet.AutoFilterMode = True Then
        Selection.AutoFilter
    Else
    End If
'To Exclude 2003 from the list
    Selection.AutoFilter
    Selection.AutoFilter Field:=2, Criteria1:="<>*2003*", Operator:=xlAnd
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Raw 2"


    Sheets("Raw").Select
    Range("A:G").Select
    Selection.Copy
    Sheets("Raw 2").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("1:23").Select
    Selection.Delete Shift:=xlUp
    Range("F1").FormulaR1C1 = ("Description")
    Range("G1").FormulaR1C1 = ("Actual+Final")
    Columns("A:A").Select
    Selection.Cut
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A61553").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveCell.EntireRow.Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
'Replace Multiple location codes with a Name
    Columns("A:A").Select
    Selection.Replace What:="7710", Replacement:="Aus", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="7711", Replacement:="Aus", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="7712", Replacement:="Aus", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="7713", Replacement:="Aus", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="7714", Replacement:="Aus", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="7715", Replacement:="Aus", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="7716", Replacement:="Aus", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="7801", Replacement:="Msia", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="7803", Replacement:="Msia", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="8601", Replacement:="HK", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="8701", Replacement:="HK", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="8801", Replacement:="JP", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="8802", Replacement:="JP", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="MHID", Replacement:="India", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="MHIM", Replacement:="India", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
'Replace all Negative Figures with 1
    For Each RowC In Range("F2:F23000").Rows
        If RowC.Value = "" Then
            GoTo Outside
        ElseIf RowC.Value < 0 Then
            RowC.Value = 1
        End If
    Next
Outside:
'Draw Pivot Table
    Columns("A:G").Select
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "'Raw 2'!A:G").CreatePivotTable TableDestination:="", TableName:= _
        "PivotTable1", DefaultVersion:=xlPivotTableVersion10


    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Product")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Description")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Location site SNP")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Actual+Final"), "Count of Actual+Final", xlCount
    Range("A1").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of Actual+Final"). _
        Function = xlSum
    Range("A2").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Product").Subtotals = Array _
        (False, False, False, False, False, False, False, False, False, False, False, False)
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Location site SNP")
        .PivotItems("(blank)").Visible = False
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Product")
        .PivotItems("(blank)").Visible = False
    End With
    ActiveSheet.Name = "PivotTable1"
    Sheets("PivotTable1").Select
    Sheets("PivotTable1").Move After:=Sheets(3)
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A61553").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveCell.EntireRow.Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
'Create Working Sheet and Top15
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Working"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "For Top15"
    Sheets("PivotTable1").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Working").Select
    Range("A2").Select
    ActiveSheet.Paste
'Top15 Tab
    Sheets("For Top15").Select
    Range("A2").Select
    ActiveSheet.Paste
    Cells.Select
    Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.EntireColumn.AutoFit
    Range("AZ2").Select
    Selection.End(xlToLeft).Select
    ActiveCell.Offset(0, 1).Activate
    ActiveCell.FormulaR1C1 = "Brand"
    ColNo4Brand2 = ActiveCell.Column
    Range("A2").Select
    Selection.End(xlDown).Select
    ActiveCell.EntireRow.Select
    Selection.Delete Shift:=xlUp
    Range("A2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, ColNo4Brand2 - 1).Activate
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[" & (-ColNo4Brand2 + 1) & "],'Raw 2'!C[" & (-ColNo4Brand2 + 4) & "]:C[" & (-ColNo4Brand2 + 8) & "],4,0)"
    ActiveCell.Copy
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Brand"
    ActiveCell.EntireColumn.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Cut
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Rows("2:2").Select
    Selection.AutoFilter
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "File created on:"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "=NOW()"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Units for ALL items are in SC"
    Range("A1:C1").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Converts EB to SC for champaigns
    Top15LastRow = Range("AZ2").End(xlToLeft).End(xlDown).Row
    For Each Top15EB In Range(Cells(3, 4), Cells(Top15LastRow, ColNo4Brand2)).Rows
        'Nested Ifs
        If Top15EB.Columns(1).Offset(0, -1).Value <> "CP" Then
        If Top15EB.Columns(1).Offset(0, -1).Value <> "MC" Then
        If Top15EB.Columns(1).Offset(0, -1).Value <> "DP" Then
        If Top15EB.Columns(1).Offset(0, -1).Value <> "KG" Then
        If Top15EB.Columns(1).Offset(0, -1).Value <> "RU" Then
            'MsgBox "Not CP " & "Col" & Top15EB.Column & " row" & Top15EB.Row
            GoTo Top15Loop
        End If
        End If
        End If
        End If
        End If


        For EB = 1 To ColNo4Brand2 - 4
            If Top15EB.Columns(EB).Value = "" Then
                GoTo NextEB
            End If
            ToSC = Top15EB.Columns(EB).Value
            'MsgBox "Col" & Top15EB.Column & " row" & Top15EB.Row & " EB " & EB
            ToSC = Round(ToSC * 75 / 900, 3)
            Top15EB.Columns(EB).Value = ToSC
NextEB:
        Next EB
Top15Loop:
    Next


    Range("B1").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
    End With
    MsgBox "A prompt to Overwrite ""For Top15"" File will appear Next. Click Yes to save the file" & vbCrLf & vbCrLf & "If you click NO, please save the file manually"
    Sheets("For Top15").Select
    Sheets("For Top15").Move
    On Error GoTo DoNotOverWr
    ActiveWorkbook.SaveAs Filename:= _
        "S:\Logistics\Outbound\Forecast meeting\Top15 items for all locations.xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False


    If ErrorNo = 0 Then 'ErrorNo is 999 set on top
DoNotOverWr:
        MsgBox "Please >Save< the file >Manually<"
    End If


    Workbooks(WB1).Activate


'Working Tab now
    Sheets("Working").Select
    Range("A2").Select
    Selection.End(xlToRight).Select
    ActiveCell.EntireColumn.Select
    Selection.Delete Shift:=xlToLeft
    Range("A2").Select
    Selection.End(xlDown).Select
    ActiveCell.EntireRow.Select
    Selection.Delete Shift:=xlUp
'Remove all 0
    Cells.Select
    Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.EntireColumn.AutoFit
'Replace all values above 0 to 1
    FinalRow = Range("A65536").End(xlUp).Row
    FinalCol = Range("AZ2").End(xlToLeft).Column
    Range("B3").Select
    For Each ColM In Worksheets("Working").Range("C3:AZ" & FinalRow).Columns
        For Each RowM In Worksheets("Working").Range("C3:AZ" & FinalRow).Rows
            ColNo = ColM.Column
            If RowM.Columns(ColNo - 2).Value > 0 Then
                RowM.Columns(ColNo - 2).Value = 1
            End If
        Next
    Next


'Adding Grand Total in Working
    Range("AZ2").Select
    Selection.End(xlToLeft).Select
    ActiveCell.Offset(0, 1).Activate
    ActiveCell.FormulaR1C1 = "Grand Total"
    ColNo4Total = ActiveCell.Column
    Range("A2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, ColNo4Total - 1).Activate
    ActiveCell.FormulaR1C1 = "=Sum(RC[" & (-ColNo4Total + 3) & "] : RC[-1])"
    ActiveCell.Copy
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Grand Total"
'Adding Brand in Working
    ActiveCell.Offset(0, 1).Activate
    ActiveCell.FormulaR1C1 = "Brand"
    ColNo4Brand = ActiveCell.Column
    Range("A2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, ColNo4Brand - 1).Activate
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[" & (-ColNo4Brand + 1) & "],'Raw 2'!C[" & (-ColNo4Brand + 4) & "]:C[" & (-ColNo4Brand + 8) & "],4,0)"
    ActiveCell.Copy
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Brand"
    Set BrandLoc = ActiveCell   '<< store "Brand" Location to sort later
    ActiveCell.EntireColumn.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Draw Lines in Working
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Rows("2:2").Select
    Selection.AutoFilter
    Range("C3").Select
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Common SKUs"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Specific SKUs"
    Sheets("Working").Select
'Sort by brand in ascending order
    Selection.Sort Key1:=Range(BrandLoc.Address), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
'Seperate into Common and Unique Tabs
    Selection.AutoFilter Field:=ColNo4Total, Criteria1:="1"
    Cells.Select
    Selection.Copy
    Sheets("Specific SKUs").Select
    Cells.Select
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("C3").Select
    Sheets("Working").Select
    Selection.AutoFilter Field:=ColNo4Total, Criteria1:=">1", Operator:=xlAnd
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Common SKUs").Select
    Cells.Select
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("C:C").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlToRight
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "Comments"
    Range("C3").Select
    Sheets("Working").Select
    Selection.AutoFilter Field:=ColNo4Total
    Sheets("Common SKUs").Select
End Sub
 
Last edited by a moderator:
Upvote 0
You must log in or register to reply here.

Similar threads

mehidy1437
  • Solved
Export Image from all files in VBA
Replies
3
Views
1K
Dan_W
D
Tim_D
  • Question
VBA Structure Best Practices and Code Review
2
Replies
13
Views
4K
dmt32
D
S
  • Question
Count ONLY numeric values?
Replies
6
Views
796
maabadi
M
D
  • Question
Macro compatibility issue from excel 2016 version to 2010 version
Replies
3
Views
1K
Fluff
Fluff
D
  • Question
Recorded Macro Combined with Established VBA code
Replies
1
Views
633
Logit
Logit

Forum statistics

Threads
1,214,861
Messages
6,121,971
Members
449,059
Latest member
oculus

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