turn of screen updating for test; start work on building price list file

PriceLists.bas

@@ -42,6 +42,8 @@ Sub test_full20()
         Exit Sub
     End If
     
+    Application.ScreenUpdating = False
+    
     With orig.Interior
         .Pattern = xlNone
         .TintAndShade = 0
@@ -88,7 +90,7 @@ Sub test_full20()
         Call x.SHTp_Dump(cms_pl, new_sh.Name, 1, 1, True, True)
         new_sh.Select
         ActiveSheet.Cells(1, 1).CurrentRegion.Select
-        Selection.Columns.AutoFit
+        Selection.Columns.autofit
         
         Rows("1:1").Select
         With ActiveWindow
@@ -189,6 +191,7 @@ Sub test_full20()
         Selection.Columns(pcol(i) + 1).Interior.Pattern = xlNone
     Next i
 
+    Application.ScreenUpdating = True
     
     '----------------------------cleanup-------------------------------------------------------------
     
@@ -484,3 +487,209 @@ Function unpivot_current_sheet(ByRef lists() As String, ByRef pcol() As Long) As
     unpivot_current_sheet = load
 
 End Function
+
+get_price
+
+Sub build_pretty()
+
+    Dim x As New TheBigOne
+    Dim pl() As String
+    Dim nwb As Workbook
+    Dim nws As Worksheet
+    Dim prettyfilepath As String
+    Dim c As Range
+    Dim i As Long
+    Dim j As Long
+    Dim last As Long
+    Dim lastcol As Long
+    
+    '---------------------get price list------------------------------------------------------------------------
+    login.Show
+    If Not login.proceed Then Exit Sub
+    pl = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('U.AAA.DI')", False, 2000, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5030;Database=ubm")
+    If pl(0, 0) <> "Product" Then
+        MsgBox (pl(0, 0))
+        Exit Sub
+    End If
+    
+    '---------------------create new workbook-------------------------------------------------------------------
+    Set nwb = Application.Workbooks.Add
+    nwb.Activate
+    Set nws = nwb.Sheets(1)
+    Set nws.Name = "Price List"
+    nws.Activate
+    nws.Cells.NumberFormat = "@"
+    Call x.SHTp_Dump(pl, nws.Name, 5, 1, False, True)
+    
+    '---------------------whole sheet formatting----------------------------------------------------------------
+    nws.Columns(9).HorizontalAlignment = xlCenter
+    nws.Columns(10).HorizontalAlignment = xlRight
+    nws.Columns(11).HorizontalAlignment = xlRight
+    nws.Columns(12).HorizontalAlignment = xlCenter
+    nws.Columns(13).HorizontalAlignment = xlRight
+    nws.Columns(14).HorizontalAlignment = xlRight
+    nws.Columns(15).HorizontalAlignment = xlCenter
+    nws.Columns(16).HorizontalAlignment = xlRight
+    nws.Columns(17).HorizontalAlignment = xlRight
+    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
+        
+    '---------------------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
+    ActiveSheet.Cells(5, 1).Select
+    
+    '---------------------header formatting---------------------------------------------------------------------
+    For Each c In Range("I5:Q5").Cells
+        c.value = Left(c.value, Len(c.value) - 1)
+    Next c
+    Application.DisplayAlerts = False
+    nws.Range("I4:K4").MergeCells = True
+    nws.Range("L4:N4").MergeCells = True
+    nws.Range("O4:Q4").MergeCells = True
+    Application.DisplayAlerts = True
+    
+    '---------------------find size of table---------------------------------------------------------------------
+    i = 6
+    Do Until nws.Cells(i, 18) = ""
+        i = i + 1
+    Loop
+    last = i - 1
+    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)
+        If nws.Cells(i, 20) = "1" And Not nws.Cells(i, 18) = "header" Then Call banding(nws, i, 1, lastcol)
+        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------
+        If nws.Cells(i, 1) = nws.Cells(i - 1, 1) And nws.Cells(i, 1) <> nws.Cells(i + 1, 1) Then
+            j = -1
+            Do Until nws.Cells(i + j, 1) <> nws.Cells(i, 1)
+                j = j - 1
+            Loop
+            j = j + 1
+            If j < 0 Then Call merge(nws, i + j, i)
+        End If
+    Next i
+    Application.ScreenUpdating = True
+    
+    '--------------------save file--------------------------------------------------------------------------------
+    'prettyfilepath = "C:\Users\PTrowbridge\Downloads\PriceListPackage\" & "U.AAA.DI" & "\" & "HC Companies Distributor Price List.xlsx"
+    'Call nwb.SaveAs(prettyfilepath, "XLSX")
+
+    
+End Sub
+
+Function rrange(ByRef sheet As Worksheet, start_row As Long, end_row As Long, start_col As Long, end_col As Long) As Range
+
+    Set rrange = Range(sheet.Cells(start_row, start_col).address & ":" & sheet.Cells(end_row, end_col).address)
+
+End Function
+
+Sub merge(ByRef ws As Worksheet, start_row As Long, end_row As Long)
+
+    Dim Sel As Range
+    Dim i As Long
+    
+    Application.DisplayAlerts = False
+
+    For i = 1 To 2
+        Set Sel = rrange(ws, start_row, end_row, i, i)
+        
+        With Sel
+            .HorizontalAlignment = xlLeft
+            .VerticalAlignment = xlCenter
+            .WrapText = False
+            .Orientation = 0
+            .AddIndent = False
+            .IndentLevel = 0
+            .ShrinkToFit = False
+            .ReadingOrder = xlContext
+            .MergeCells = True
+        End With
+    Next i
+    
+    Application.DisplayAlerts = True
+    
+End Sub
+
+Sub compatible(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
+
+End Sub
+
+Sub banding(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)
+    
+    With Sel.Interior
+        .Pattern = xlSolid
+        .PatternColorIndex = xlAutomatic
+        .ThemeColor = xlThemeColorAccent3
+        .TintAndShade = 0.799981688894314
+        .PatternTintAndShade = 0
+    End With
+    
+
+End Sub
+
+Sub pretty_green(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)
+
+    With Sel.Interior
+        .Pattern = xlSolid
+        .PatternColorIndex = xlAutomatic
+        .ThemeColor = xlThemeColorAccent6
+        .TintAndShade = 0.799981688894314
+        .PatternTintAndShade = 0
+    End With
+    Sel.Borders(xlDiagonalDown).LineStyle = xlNone
+    Sel.Borders(xlDiagonalUp).LineStyle = xlNone
+    With Sel.Borders(xlEdgeLeft)
+        .LineStyle = xlContinuous
+        .ThemeColor = 1
+        .TintAndShade = 0
+        .Weight = xlThick
+    End With
+    With Sel.Borders(xlEdgeTop)
+        .LineStyle = xlContinuous
+        .ThemeColor = 1
+        .TintAndShade = 0
+        .Weight = xlThick
+    End With
+    With Sel.Borders(xlEdgeBottom)
+        .LineStyle = xlContinuous
+        .ThemeColor = 1
+        .TintAndShade = 0
+        .Weight = xlThick
+    End With
+    With Sel.Borders(xlEdgeRight)
+        .LineStyle = xlContinuous
+        .ThemeColor = 1
+        .TintAndShade = 0
+        .Weight = xlThick
+    End With
+    Sel.Borders(xlInsideVertical).LineStyle = xlNone
+    Sel.Borders(xlInsideHorizontal).LineStyle = xlNone
+
+
+End Sub
+
+
+