more formatting

PriceLists.bas

@@ -516,10 +516,11 @@ Sub build_pretty()
     Set nwb = Application.Workbooks.Add
     nwb.Activate
     Set nws = nwb.Sheets(1)
-    Set nws.Name = "Price List"
     nws.Activate
-    nws.Cells.NumberFormat = "@"
+    nws.Name = "USD"
+    nws.Cells.NumberFormat = "@" 'format all cells to text so pasted text values are not cast to numeric
     Call x.SHTp_Dump(pl, nws.Name, 5, 1, False, True)
+    Application.ScreenUpdating = False
     
     '---------------------whole sheet formatting----------------------------------------------------------------
     nws.Columns(9).HorizontalAlignment = xlCenter
@@ -531,16 +532,37 @@ Sub build_pretty()
     nws.Columns(15).HorizontalAlignment = xlCenter
     nws.Columns(16).HorizontalAlignment = xlRight
     nws.Columns(17).HorizontalAlignment = xlRight
+    nws.Columns(1).ColumnWidth = 12
+    nws.Columns(2).ColumnWidth = 70
+    nws.Columns(3).ColumnWidth = 8.29
+    nws.Columns(4).ColumnWidth = 4.86
+    nws.Columns(5).ColumnWidth = 4.86
+    nws.Columns(6).ColumnWidth = 4.86
+    nws.Columns(7).ColumnWidth = 4.86
+    nws.Columns(8).ColumnWidth = 11
+    nws.Columns(9).ColumnWidth = 17.71
+    nws.Columns(12).ColumnWidth = 17.71
+    nws.Columns(15).ColumnWidth = 17.71
+    nws.Columns(10).ColumnWidth = 10.57
+    nws.Columns(13).ColumnWidth = 10.57
+    nws.Columns(16).ColumnWidth = 10.57
+    nws.Columns(11).ColumnWidth = 11.71
+    nws.Columns(14).ColumnWidth = 11.71
+    nws.Columns(17).ColumnWidth = 11.71
     ActiveWindow.DisplayGridlines = False
-    Columns("B:B").EntireColumn.autofit
-    Columns("A:A").ColumnWidth = 10.71
     nws.Cells.Font.Name = "Cascadia Code Light"
     nws.Cells.Font.Size = 10
+    Rows("6:6").Select
+    ActiveWindow.FreezePanes = True
+    nws.Cells(2, 3).value = "Distributor Price List (USD) - Effective 6/1/2022"
         
     '---------------------logo----------------------------------------------------------------------------------
     ActiveSheet.Cells(1, 1).Select
     ActiveSheet.Pictures.Insert("https://hc-companies.com/wp-content/themes/hc-companies/images/logo.svg").Select
     Selection.ShapeRange.ScaleHeight 0.6, msoFalse, msoScaleFromTopLeft
+    Selection.ShapeRange.IncrementLeft 2
+    Selection.ShapeRange.IncrementTop 2
+    ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Shapes.Item(1), address:="https://hc-companies.com/"
     ActiveSheet.Cells(5, 1).Select
     
     '---------------------header formatting---------------------------------------------------------------------
@@ -548,9 +570,21 @@ Sub build_pretty()
         c.value = Left(c.value, Len(c.value) - 1)
     Next c
     Application.DisplayAlerts = False
-    nws.Range("I4:K4").MergeCells = True
+    With nws.Range("I4")
-    nws.Range("L4:N4").MergeCells = True
+        .value = "-----------Single Package--------"
-    nws.Range("O4:Q4").MergeCells = True
+        .HorizontalAlignment = xlLeft
+        .InsertIndent 3
+    End With
+    With nws.Range("L4")
+        .value = "------------Full Pallet----------"
+        .HorizontalAlignment = xlLeft
+        .InsertIndent 3
+    End With
+    With nws.Range("O4")
+        .value = "------------Bulk Pallet----------"
+        .HorizontalAlignment = xlLeft
+        .InsertIndent 3
+    End With
     Application.DisplayAlerts = True
     
     '---------------------find size of table---------------------------------------------------------------------
@@ -562,13 +596,24 @@ Sub build_pretty()
     lastcol = 17
     
     '--------------------line formatting--------------------------------------------------------------------------
-    Application.ScreenUpdating = False
     For i = 6 To last
-        If nws.Cells(i, 18) = "header" Then Call pretty_green(nws, i, 1, lastcol)
+        '--------------------format header---------------
+        If nws.Cells(i, 18) = "header" Then Call header(nws, i, 1, lastcol)
+        '--------------------create bands---------------
         If nws.Cells(i, 20) = "1" And Not nws.Cells(i, 18) = "header" Then Call banding(nws, i, 1, lastcol)
+        '--------------------indent compatible---------------
         If nws.Cells(i, 18) = "compatible" Then Call compatible(nws, i, 1, 2)
-        '----if the next row is different and the previous row is the same the loop back and merge the range------
+        '--------------------highlight price---------------
+        If nws.Cells(i, 18) <> "header" Then Call price_col(nws, i, 20)
+        '--------------------comment empy qty to prevent colors from spilling
+        If nws.Cells(i, 9) = "" Then nws.Cells(i, 9) = "'"
+        If nws.Cells(i, 11) = "" Then nws.Cells(i, 11) = "'"
+        If nws.Cells(i, 12) = "" Then nws.Cells(i, 12) = "'"
+        If nws.Cells(i, 14) = "" Then nws.Cells(i, 14) = "'"
+        If nws.Cells(i, 15) = "" Then nws.Cells(i, 15) = "'"
+        '--------------------merge products---------------
         If nws.Cells(i, 1) = nws.Cells(i - 1, 1) And nws.Cells(i, 1) <> nws.Cells(i + 1, 1) Then
+            'if the next row is different and the previous row is the same the loop back and merge the range
             j = -1
             Do Until nws.Cells(i + j, 1) <> nws.Cells(i, 1)
                 j = j - 1
@@ -577,8 +622,12 @@ Sub build_pretty()
             If j < 0 Then Call merge(nws, i + j, i)
         End If
     Next i
+    nws.Columns("R:T").Delete
+    nws.Cells(5, 1).Select
     Application.ScreenUpdating = True
     
+    Call page_setup
+    
     '--------------------save file--------------------------------------------------------------------------------
     'prettyfilepath = "C:\Users\PTrowbridge\Downloads\PriceListPackage\" & "U.AAA.DI" & "\" & "HC Companies Distributor Price List.xlsx"
     'Call nwb.SaveAs(prettyfilepath, "XLSX")
@@ -592,6 +641,39 @@ Function rrange(ByRef sheet As Worksheet, start_row As Long, end_row As Long, st
 
 End Function
 
+Sub price_col(ByRef sheet As Worksheet, row As Long, flag_col As Long)
+
+    Dim Sel As Range
+    Dim i As Long
+    
+    i = 0
+    Do Until i = 9
+        Set Sel = rrange(sheet, row, row, 10 + i, 10 + i)
+
+        If sheet.Cells(row, flag_col) = "0" Then
+            With Sel.Interior
+                .Pattern = xlSolid
+                .PatternColorIndex = xlAutomatic
+                .ThemeColor = xlThemeColorAccent4
+                .TintAndShade = 0.799981688894314
+                .PatternTintAndShade = 0
+            End With
+        Else
+            With Sel.Interior
+                .Pattern = xlSolid
+                .PatternColorIndex = xlAutomatic
+                .ThemeColor = xlThemeColorAccent4
+                .TintAndShade = 0.599993896298105
+                .PatternTintAndShade = 0
+            End With
+        End If
+        i = i + 3
+    Loop
+
+
+End Sub
+
+
 Sub merge(ByRef ws As Worksheet, start_row As Long, end_row As Long)
 
     Dim Sel As Range
@@ -646,12 +728,14 @@ Sub banding(ByRef ws As Worksheet, row As Long, start_col As Long, end_col As Lo
 
 End Sub
 
-Sub pretty_green(ByRef ws As Worksheet, row As Long, start_col As Long, end_col As Long)
+Sub header(ByRef ws As Worksheet, row As Long, start_col As Long, end_col As Long)
 
     Dim Sel As Range
     
     Set Sel = rrange(ws, row, row, start_col, end_col)
 
+    Sel.InsertIndent 2
+    Sel.Font.Size = 11
     With Sel.Interior
         .Pattern = xlSolid
         .PatternColorIndex = xlAutomatic
@@ -691,5 +775,23 @@ Sub pretty_green(ByRef ws As Worksheet, row As Long, start_col As Long, end_col
 
 End Sub
 
+Sub print_setup(sheet As Worksheet, last_row As Long)
 
+    Dim Sel As Range
     
+    Set Sel = rrange(sheet, 6, last_row, 1, 17)
+
+    With sheet.PageSetup
+        .PrintArea = Sel.address
+        .PrintTitleRows = "$1:$5"
+        .LeftMargin = Application.InchesToPoints(0.7)
+        .RightMargin = Application.InchesToPoints(0.7)
+        .TopMargin = Application.InchesToPoints(0.75)
+        .BottomMargin = Application.InchesToPoints(0.75)
+        .HeaderMargin = Application.InchesToPoints(0.3)
+        .FooterMargin = Application.InchesToPoints(0.3)
+        .Orientation = xlLandscape
+        .FitToPagesWide = 1
+    End With
+    
+End Sub