Buyer Report Code

Sub Master()

If MsgBox("This is a demanding macro.  Please be sure to save any other work to avoid losing it.  This will take about 5 minutes.  Ready to start?", vbYesNo) = vbNo Then Exit Sub

Application.ScreenUpdating = False

'\\//CAO Processes
Call RemoveDashOnes
Call CAO_Report
Call CAO_Breakout
Call CAO_Clean
'//\\

'Delete Max Facings Column
Sheets("Group_PositionList").Activate
ActiveSheet.Range("K1").EntireColumn.Delete

'Convert all movements & counts to numbers
Dim lastcol As Long, lastrow As Long, GPL As Workbook
lastcol = Sheets("Group_PositionList").Cells(1, Columns.Count).End(xlToLeft).Column
lastrow = Sheets("Group_PositionList").Cells(Rows.Count, 1).End(xlUp).Row

    ActiveSheet.Range(Cells(2, 5), Cells(lastrow, lastcol)).Select
        With Selection
            .NumberFormat = "General"
            .Value = .Value
        End With

'Get Estimated Reset Inventory, this tells the inventory for the additional stores carrying each item.
'Change all POG UPC counts to 1
Call GetERI

'Build Additional Stores Using Item Sheet
    With ActiveWorkbook
        .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Addtnl Strs Per Item"
    End With
Sheets("Group_PositionList").Activate

'=====Copy the data=====
Sheets("Group_PositionList").Range("A1:F" & Range("F" & Rows.Count).End(xlUp).Row).Copy
'Activate the destination worksheet
Sheets("Addtnl Strs Per Item").Activate
'Select the target range
Range("A1").Select
'Paste in the target destination
ActiveSheet.Paste
Application.CutCopyMode = False

Sheets("Group_PositionList").Activate
Sheets("Group_PositionList").Range("J1:J" & Range("J" & Rows.Count).End(xlUp).Row).Copy
'Activate the destination worksheet
Sheets("Addtnl Strs Per Item").Activate
'Select the target range
Range("G1").Select
'Paste in the target destination
ActiveSheet.Paste
Application.CutCopyMode = False

'=====From Copy Headers=====
'Find Last Column Used
lastcol = Sheets("Group_PositionList").Cells(1, Columns.Count).End(xlToLeft).Column
lastrow = Sheets("Group_PositionList").Cells(Rows.Count, 1).End(xlUp).Row
'Copy through last header
Sheets("Group_PositionList").Select
ActiveSheet.Range(Cells(1, 11), Cells(lastrow, lastcol - 1)).Select
    Selection.Copy
'Activate Target Worksheet
Sheets("Addtnl Strs Per Item").Activate
'Select Target Range
Range("H1").Select
'Paste in Target Destination
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Cells.EntireColumn.AutoFit

'=====Run Input Macros=====

'Run Input_PoG_Usage
Call Input_PoG_Usage

'Add header to last column
    With ActiveSheet
        Range("A1").End(xlToRight).Select
        ActiveCell.Offset(, 1).Activate
'Changed from Number of stores carrying item
        ActiveCell.Value = "Change in stores carrying"

'Color Store Count
        .Range("A1").End(xlToRight).Select
            Selection.EntireColumn.Interior.Color = RGB(200, 200, 200)
    End With

'Run BuyerWarehouse
Call BuyerWarehouse

'Run Calculate
Call Calculate

'=====Formatting=====

'Color Rows based on Max Position Count
    Range("A2:G" & Range("G" & Rows.Count).End(xlUp).Row).Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$G2=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 6908415
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False

'Hide Group_PositionList Sheet
    Sheets("Group_PositionList").Visible = False

'Freeze Top Row, Rename Headers, & AutoFit Columns
Rows("2:2").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
With ActiveSheet
    .Range("A1").Value = "Order #"
    .Range("B1").Value = "UPC"
    .Range("E1").Value = "Current Store Count"
    .Range("F1").Value = "Mvmnt"
    .Cells.EntireColumn.AutoFit
    .Range("A1").Select
End With

'Add Title & Reset Date
    Rows("1:1").Select
    Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Value = Application.InputBox("Buyer Report Title?")
    Range("A2").Select
    Selection.End(xlToRight).Select
    Selection.Offset(-1, -2).Value = "Reset Date: "
    Selection.Offset(-1, -2).HorizontalAlignment = xlRight
    Selection.Offset(-1, -1).Value = Application.InputBox("Reset Date?")
    Selection.Offset(-1, -1).HorizontalAlignment = xlLeft
    Set GPL = ActiveWorkbook
'CAO Relocate
    Call CAO_Relocate_New

'Add Estimated Reset Inventory and multiply by Change in store count.
    GPL.Sheets("Group_PositionList").Activate
    ActiveSheet.Range("A1").Select
    Selection.End(xlToRight).Select
    Selection.Offset(, -1).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Offset(, 1).Select
    Selection.Copy

'Activate the destination worksheet
    Sheets("Addtnl Strs Per Item").Activate
'Select the target range
    With ActiveSheet
        Range("A2").End(xlToRight).Select
        ActiveCell.Offset(, 1).Select
    End With
'Paste in the target destination
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With ActiveSheet
        .Cells.EntireColumn.AutoFit
        .Range("A:A").ColumnWidth = 9.6
    End With
'Multiply by change in store count
Dim e As Long, f As Long

    With Sheets("Addtnl Strs Per Item")
    lastcol = .Cells(2, Columns.Count).End(xlToLeft).Column
    lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
    chng = .Cells(3, lastcol - 3).Column

        For e = 3 To lastrow
            For f = lastcol To lastcol
                If Cells(e, lastcol).Value > 0 Then
                      Cells(e, lastcol).Value = .Cells(e, lastcol).Value * Cells(e, chng).Value
                End If
           Next
        Next e
    .Cells(1, lastcol).ColumnWidth = 11.25
    .Range(Cells(2, lastcol), Cells(lastrow, lastcol)).Interior.ColorIndex = 43
    .Range(Cells(2, lastcol), Cells(lastrow, lastcol)).EntireColumn.NumberFormat = "0"
    .Cells(2, lastcol).Value = "Est Reset Inv"

        For e = 3 To lastrow
            If Round(Cells(e, lastcol)) < .Cells(e, chng) Then
                .Cells(e, chng).Interior.ColorIndex = 43
                .Cells(e, lastcol).Interior.ColorIndex = 46
            End If
        Next e
    End With

'Hide POG Columns
    Range("H1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.EntireColumn.Hidden = True
    Range("A2").End(xlToRight).Select
    Selection.Offset(, -3).EntireColumn.Hidden = False


'Buyer Name Lookup
    Range("A2").End(xlToRight).Select
    Selection.Offset(, 1).Select
    Selection.Value = "Buyer Name"

    Selection.Offset(1, 0).Activate
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-2]>1,VLOOKUP(RC[-2],'[Buyer Report Generator V5.xlsm]Buyer_Report_Generator'!R2C1:R38C2,2,FALSE),"""")"

    lastrow = Range("B2").End(xlDown).Row
    ActiveCell.AutoFill Range(ActiveCell.Address, Cells(lastrow, ActiveCell.Column))


'Paste Values
    Range("A2").Select
    Selection.End(xlToRight).Select
    Selection.EntireColumn.Copy

    Range("A2").End(xlToRight).Select
    Selection.Offset(-1, 0).Select

    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False

'Final AutoFit & add filters
    ActiveSheet.Range("A2").End(xlToRight).Select
    Selection.EntireColumn.AutoFit
    ActiveSheet.Range("A2").AutoFilter
    ActiveSheet.Range("A1").Select

    Workbooks("Buyer Report Generator V5.xlsm").Close False
    GPL.Sheets("Addtnl Strs Per Item").Activate
    MsgBox "Macro Complete"

End Sub
Sub RemoveDashOnes()
Dim lstrow As Long

lstrow = Sheets("Group_PositionList").Cells(Rows.Count, 2).End(xlUp).Row

For R = 2 To lstrow
    If Right(Cells(R, 2).Value, 2) = "-1" Then
        Cells(R, 2).EntireRow.Delete shift:=xlUp
        R = R - 1
    End If
Next

End Sub
Sub CAO_Report()
Application.ScreenUpdating = False

'Create new tab
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
ActiveSheet.Name = "Distribution"
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
ActiveSheet.Name = "CAO Report"
Range("A:A").EntireColumn.Delete
Range("B:J").EntireColumn.Delete

'Format new tab and strip down to needed data
Dim lstcol As Long, lastrow As Long, strnmbr As Range, Replace As String, Arng As Range
lastrow = Sheets("CAO Report").Cells(Rows.Count, 1).End(xlUp).Row
lstcol = Sheets("CAO Report").Cells(1, Columns.Count).End(xlToLeft).Column
Set Arng = Range("A2:A" & lastrow)

For Each Cell In Arng
    Cell.Value = Left(Cell, Len(Cell) - 1)
    Cell.NumberFormat = "0000000000000"
Next
With Range("A:A")
    .ColumnWidth = 14
    .Value = Range("A:A").Value
End With

'Pull store numbers from POG names
For c = 2 To lstcol
    Set strnmbr = Cells(1, c)
    Replace = Mid(strnmbr, Len(strnmbr) - 6, 3)
    strnmbr = Replace
Next c

End Sub
Sub CAO_Breakout()

Application.ScreenUpdating = False

Dim P_ID As Range, lstcol As Long, lstrow As Long, caosht As Worksheet, _
lstcol2 As Long

lstrow = Sheets("CAO Report").Cells(Rows.Count, 1).End(xlUp).Row
lstcol = Sheets("CAO Report").Cells(1, Columns.Count).End(xlToLeft).Column
Set caosht = ActiveWorkbook.Worksheets("CAO Report")
Set P_ID = caosht.Range("A1:A" & lstrow)

'Looper makes new tab for store, if it already exists, go to "ExistingStrNum"
On Error GoTo ExistingStrNum
Looper:
For POG = 2 To lstcol
    ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = caosht.Cells(1, 2).Value
    P_ID.Copy
    ActiveSheet.Paste
    ActiveSheet.Range("A:A").ColumnWidth = 14
    caosht.Range("B:B").Cut ActiveSheet.Range("B:B")
    caosht.Range("B:B").EntireColumn.Delete

Next POG
'\\//when loop finishes, go to "here" in order to skip error handling
GoTo Here

'Add duplicate store number data to existing tab
ExistingStrNum:
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True

If caosht.Cells(1, 2) <> "" Then
    Sheets(caosht.Cells(1, 2).Value).Activate
    lstcol2 = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Else
    GoTo Here
End If

Cells(1, lstcol2 + 1).Activate
caosht.Range("B:B").Cut ActiveSheet.Cells(1, lstcol2 + 1)
caosht.Range("B:B").EntireColumn.Delete

Resume Looper

Here:
Application.DisplayAlerts = False
caosht.Delete
Application.DisplayAlerts = True

End Sub
Sub CAO_Clean()

Application.ScreenUpdating = False

Dim wbSource As Workbook, wbDest As Workbook, sht As Worksheet, sname As String, _
relPath As String, lstrow As Long, lstcol As Long

'Copying book
Set wbSource = ActiveWorkbook

For Each sht In wbSource.Worksheets
    If sht.Name = "Group_PositionList" Or sht.Name = "Distribution" Then
    Else
    lstcol = sht.Cells(1, Columns.Count).End(xlToLeft).Column
    lstrow = sht.Cells(Rows.Count, 1).End(xlUp).Row
    'For Each col In wbSource.Worksheets
    On Error Resume Next
    sht.Range("B2", Cells(lstrow, lstcol)).NumberFormat = "0"
    sht.Range("B2", Cells(lstrow, lstcol)).Value = sht.Range("B2", Cells(lstrow, lstcol)).Value
        If lstcol > 2 Then
            For c = 2 To lstrow
                sht.Cells(c, 2).Value = WorksheetFunction.Sum(sht.Range(Cells(c, 2), Cells(c, lstcol)))
            Next
        Else
        sht.Range("B2", Cells(lstrow, lstcol)).NumberFormat = "0"
        sht.Range("B2", Cells(lstrow, lstcol)).Value = sht.Range("B2", Cells(lstrow, lstcol)).Value
        End If
    'Next col
    End If
Next sht


For Each sht In wbSource.Worksheets
    VBA.DoEvents
    If sht.Name = "Group_PositionList" Or sht.Name = "Distribution" Then
        Else
        lstrow = sht.Cells(Rows.Count, 1).End(xlUp).Row
        For y = 2 To lstrow
            If sht.Cells(y, 1) <> "" Then
                If sht.Cells(y, 2).Value <> "0" Then
                    sht.Cells(y, 2).EntireRow.Delete
                    y = y - 1
                    lstrow = lstrow - 1
                Else
                    sht.Cells(y, 2).Value = sht.Cells(1, 2).Value
                End If
            Else
                Exit For
            End If
        Next y
    End If
Next

End Sub
Sub GetERI()

'Estimated Reset Inventory
'Divide each POG's Units on Shelf by Each item's Units_Case, then average each line into new column.
'This will be multiplied by change in store count.
Dim e As Long, lastrow As Long, lastcol As Long, f As Long, rng As Range, rng2 As Range

    With Sheets("Group_PositionList")
        lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
        lastrow = .Cells(Rows.Count, 1).End(xlUp).Row

        Set rng = ActiveSheet.Range(Cells(2, 11), Cells(lastrow, lastcol))

'Change 0s to empty
        For Each Cell In rng
            If Cell.Value = 0 Then
                Cell.Value = Empty
            ElseIf Cell.Value <> 0 Then
                Cell.Value = Cell.Value
            End If
        Next

'Divide each PoGs' Units on Shelf by each item's Units_Case, then average each line into new column if value is not 0
        For e = 2 To lastrow
            For f = 11 To lastcol
                If Cells(e, f).Value <> Empty Then
                      Cells(e, f).Value = .Cells(e, f).Value / Cells(e, 9).Value
                      Cells(e, lastcol + 1).Value = Application.WorksheetFunction.AverageIf(Range(Cells(e, 11), Cells(e, lastcol)), ">0")
                End If
           Next
        Next e

'Format new column
    Range("A1").Select
    Selection.End(xlToRight).Offset(, 1).Select
    Selection.Value = "Avg Cs Pk"
    Selection.EntireColumn.NumberFormat = "0.00"

'If a value on Group Position List is  more than .01, make it 1.  If not, make it 0.

    For Each Cell In rng
        If Cell.Value <> Empty Then
            Cell.Value = 1
        ElseIf Cell.Value = Empty Then
            Cell.Value = 0
            Cell.NumberFormat = "0"
        End If
    Next

    End With

Dim g As Long, lastcol2 As Long
    For g = 2 To lastrow
        lastcol2 = Sheets("Group_PositionList").Cells(1, Columns.Count).End(xlToLeft).Column
        If Cells(g, lastcol).Value = "" Then
            Cell.Value = "0"
        End If
    Next

End Sub
Sub Input_PoG_Usage()
'Taken from Stackoverflow.com
Dim sht As Worksheet, lastcol As Long, lastrow As Long, multiplier As Integer

Set sht = ActiveWorkbook.Worksheets("Addtnl Strs Per Item")
lastcol = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column

Application.ScreenUpdating = False
'Double For Loop
For i = 8 To lastcol
    If Cells(1, i) <> vbNullString Then

        '     \\// Set so that every pog will be used one time; the code below in green will offer the input box for variable usages.
        multiplier = 1
        '     //\\Application.InputBox("Number of stores using set " & Cells(1, i) & ".", , 1)
        lastrow = sht.Cells(sht.Rows.Count, 5).End(xlUp).Row

        For j = 2 To lastrow
            Cells(j, i).Value = multiplier * Cells(j, i)
        Next j
    End If
Next i
Application.ScreenUpdating = False

End Sub
Sub BuyerWarehouse()
    With ActiveSheet.Select
        Range("A1").End(xlToRight).Select
    End With
    ActiveCell.Offset(, 1).Activate
    ActiveCell.Value = "Warehouse"
    ActiveCell.Offset(, 1).Activate
    ActiveCell.Value = "Buyer Number"

lastcol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

'Copy the data
Sheets("Group_PositionList").Range("G2:H" & Range("H" & Rows.Count).End(xlUp).Row).Copy
'Activate the destination worksheet
Sheets("Addtnl Strs Per Item").Activate
'Select the target range
Cells(2, lastcol - 1).Select
'Paste in the target destination
ActiveSheet.Paste
Application.CutCopyMode = False

End Sub
Sub Calculate()

Dim i As Long, lastcol As Long, sht As Worksheet, lastrow As Long

Set sht = ActiveWorkbook.Worksheets("Addtnl Strs Per Item")
lastcol = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column
lastrow = sht.Cells(sht.Rows.Count, 5).End(xlUp).Row

    For i = 2 To lastrow
        sht.Cells(i, lastcol - 2).Value = Application.WorksheetFunction.Sum(sht.Range(sht.Cells(i, 8), sht.Cells(i, lastcol - 3))) - sht.Cells(i, 5)
    Next i

End Sub
Sub CAO_Relocate_New()
Application.ScreenUpdating = False

Dim wbSource As Workbook, wbDest As Workbook, sht As Worksheet, sname As String, _
relPath As String, Srclstrow As Long, Dstlstrow As Long, lstrow As Long, fldrName As String, newbook As Workbook

Set wbSource = ActiveWorkbook

MkDir ("S:\Ryan Prince\CAO Reports POG\" & wbSource.Worksheets("Addtnl Strs Per Item").Range("A1").Value)

Set newbook = Workbooks.Add
Workbooks("Buyer Report Generator V5.xlsm").Worksheets("DNO").Copy before:=newbook.Sheets(1)
        Application.DisplayAlerts = False
        newbook.Sheets("Sheet1").Delete
        Application.DisplayAlerts = True
        Set wbDest = newbook

For Each sht In wbSource.Sheets
    If sht.Name = "Group_PositionList" Or sht.Name = "Distribution" Or sht.Name = "Addtnl Strs Per Item" Then
    Else
        'Destination book
        Srclstrow = sht.Cells(Rows.Count, 1).End(xlUp).Row
        Dstlstrow = wbDest.Worksheets("DNO").Cells(Rows.Count, 1).End(xlUp).Row

            sht.Range("A2:A" & Srclstrow).Copy wbDest.Worksheets("DNO").Range("C" & Dstlstrow)
            sht.Range("B2:B" & Srclstrow).Copy wbDest.Worksheets("DNO").Range("A" & Dstlstrow)

            Application.DisplayAlerts = False
            sht.Delete
            Application.DisplayAlerts = True
    End If
Next

lstrow = wbDest.Worksheets("DNO").Cells(Rows.Count, 1).End(xlUp).Row

With wbDest.Worksheets("DNO")
    .Range("C:C").ColumnWidth = 14
    .Range("B2:B" & lstrow).Value = Date
    .Range("E3:E" & lstrow).Value = Range("E2").Value
    .Range("F3:F" & lstrow).Value = Range("F2").Value
    .Range("H3:H" & lstrow).Value = Range("H2").Value
    .Range("J3:J" & lstrow).Value = Range("J2").Value
    .Range("L3:L" & lstrow).Value = Range("L2").Value
    .Range("M3:M" & lstrow).Value = 0

End With

sname = wbDest.Worksheets("DNO").Cells(2, 1).Value & ".txt"
relPath = "S:\Ryan Prince\CAO Reports POG\" & wbSource.Worksheets("Addtnl Strs Per Item").Range("A1").Value & "\" & "DNO"

wbDest.SaveAs Filename:=relPath, FileFormat:=xlTextWindows
wbDest.Close False

End Sub