build full code list

PriceLists.bas

@@ -373,7 +373,7 @@ PRICELIST_SHOW:
     
     '--------Open file-------------
     
-    If Not x.FILEp_CreateCSV(pricelist.tbPath.text & "\" & Replace(pl_code, ".", "_") & ".csv", ul) Then
+    If Not x.FILEp_CreateCSV(pricelist.tbPATH.text & "\" & Replace(pl_code, ".", "_") & ".csv", ul) Then
         MsgBox ("error")
     End If
     
@@ -488,12 +488,15 @@ Function unpivot_current_sheet(ByRef lists() As String, ByRef pcol() As Long) As
 End Function
 
 
-Sub build_pretty()
+Sub build_customer_files()
 
     Dim x As New TheBigOne
     Dim pl() As String
+    Dim fc() As String
     Dim nwb As Workbook
+    Dim fcwb As Workbook
     Dim nws As Worksheet
+    Dim fcws As Worksheet
     Dim filepath As String
     Dim c As Range
     Dim i As Long
@@ -506,6 +509,8 @@ Sub build_pretty()
     Dim effdate As Date
     
     '----------------------pick price level---------------------------------------------------------------------
+    login.tbU = "report"
+    login.tbP = "report"
     login.Show
     If Not login.proceed Then Exit Sub
     Call pricelevel.repopulate
@@ -517,7 +522,68 @@ Sub build_pretty()
         Exit Sub
     End If
     effdate = CDate(pricelevel.tbEddDate.text)
-    filepath = pricelevel.tbPath & "\" & plev
+    filepath = pricelevel.tbPATH & "\" & plev
+    
+    '---------------------get full code list--------------------------------------------------------------------
+    fc = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_fullcode_cust('" & plev & "', '" & effdate & "'::date)", False, 20000, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5030;Database=ubm")
+    If fc(0, 0) <> "Currency" Then
+        MsgBox (fc(0, 0))
+        Exit Sub
+    End If
+    
+    '---------------------create new workbook-------------------------------------------------------------------
+    If UBound(fc, 2) = 0 Then
+        MsgBox ("no full code list data for " & plev)
+        Exit Sub
+    End If
+    Application.ScreenUpdating = False
+    Set fcwb = Application.Workbooks.Add
+    fcwb.Activate
+    Set fcws = fcwb.Sheets(1)
+    fcws.Activate
+    'fcws.Cells.NumberFormat = "@" 'format all cells to text so pasted text values are not cast to numeric
+    Call x.SHTp_Dump(fc, fcws.Name, 1, 1, False, True, 6, 7, 8, 9, 10, 11, 12, 13)
+    Rows("1:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
+    
+    '--------------------format full code------------------------------------------------------------------------
+    Application.CutCopyMode = False
+    fcws.ListObjects.Add(xlSrcRange, fcws.Cells(3, 1).CurrentRegion, , xlYes).Name = "Full Code Listing"
+    fcws.ListObjects("Full Code Listing").TableStyle = "TableStyleMedium21"
+    fcws.Cells.Font.Name = "Courier New"
+    fcws.Cells.Font.Size = 10
+    With fcws.Rows(3)
+        .WrapText = True
+        .RowHeight = 40.5
+    End With
+    fcws.Columns("A").ColumnWidth = 9.43
+    fcws.Columns("B").ColumnWidth = 20
+    fcws.Columns("C:D").ColumnWidth = 35
+    fcws.Columns("E").ColumnWidth = 13
+    fcws.Columns("F").ColumnWidth = 3.7
+    fcws.Columns("H").ColumnWidth = 7
+    fcws.Columns("I:P").ColumnWidth = 14
+    fcws.Columns("I:N").Style = "Comma"
+    fcws.Columns("G").Style = "Comma"
+    fcws.Activate
+    ActiveWindow.DisplayGridlines = False
+    Rows("4:4").Select
+    ActiveWindow.FreezePanes = True
+    fcws.ListObjects("Full Code Listing").ShowAutoFilter = False
+    
+    '---------------------logo----------------------------------------------------------------------------------
+    fcws.Rows("1:2").RowHeight = 28.5
+    fcws.Cells(1, 1).Select
+    fcws.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/"
+    fcws.Cells(1, 4).value = "Distributor Price List - Effective " & Format(effdate, "MM/DD/YYYY")
+    fcws.Name = "Full Code Listing"
+    fcws.Cells(3, 1).Select
+
+    'Application.ScreenUpdating = True
+    'Exit Sub
     
     '---------------------get price list------------------------------------------------------------------------
     pl = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "')", False, 2000, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5030;Database=ubm")
@@ -563,7 +629,8 @@ Sub build_pretty()
     nws.Columns(14).ColumnWidth = 11.71
     nws.Columns(17).ColumnWidth = 11.71
     ActiveWindow.DisplayGridlines = False
-    nws.Cells.Font.Name = "Cascadia Code Light"
+    'nws.Cells.Font.Name = "Cascadia Code Light"
+    nws.Cells.Font.Name = "Courier New"
     nws.Cells.Font.Size = 10
     Rows("6:6").Select
     ActiveWindow.FreezePanes = True
@@ -653,7 +720,7 @@ Sub build_pretty()
         End Select
     End If
     nws.Cells(2, 3).value = "Distributor Price List (" & curr & ") - Effective " & Format(effdate, "MM/DD/YYYY")
-    nws.Name = curr
+    nws.Name = "Price List"
     nws.Cells(5, 1).Select
     
     Call print_setup(nws, last)
@@ -687,6 +754,19 @@ Sub build_pretty()
     
     nwb.SaveAs Filename:=filepath & "\HC Companies Distributor Price List.xlsx"
     
+    For Each wb In Workbooks
+        If wb.Name = "HC FullCode List.xlsx" Then
+            If MsgBox("already have a full code list open, close it?", vbOKCancel) Then
+                Workbooks("HC FullCode List.xlsx").Close
+                Exit For
+            Else
+                Exit Sub
+            End If
+        End If
+    Next wb
+    
+    fcwb.SaveAs Filename:=filepath & "\HC FullCode List.xlsx"
+
     
 End Sub