add tabs per segment if selected

PriceLists.bas

@@ -476,21 +476,20 @@ Sub build_customer_files()
 
     Dim x As New TheBigOne
     Dim pl() As String
+    Dim pln() As String
+    Dim plf() As String
     Dim fc() As String
     Dim nwb As Workbook
     Dim fcwb As Workbook
     Dim nws As Worksheet
+    Dim nnws As Worksheet
+    Dim nfws As Worksheet
     Dim fcws As Worksheet
     Dim filepath As String
-    Dim c As Range
-    Dim i As Long
-    Dim j As Long
-    Dim last As Long
-    Dim lastcol As Long
     Dim clist() As String
-    Dim curr As String
     Dim plev As String
     Dim effdate As Date
+    Dim segment_regex As String
     
     '----------------------pick price level---------------------------------------------------------------------
     login.Caption = "PostgreSQL Login"
@@ -509,6 +508,7 @@ Sub build_customer_files()
     effdate = CDate(pricelevel.tbEddDate.text)
     filepath = pricelevel.tbPATH & "\" & plev
     
+    If pricelevel.chbFULLCODE Then
         '---------------------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
@@ -570,27 +570,122 @@ Sub build_customer_files()
         fcws.Cells(1, 4).value = "Distributor Price List - Effective " & Format(effdate, "MM/DD/YYYY")
         fcws.Name = "Full Code Listing"
         fcws.Cells(3, 1).Select
+    End If
 
     '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")
-    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)
+    segment_regex = "G|N|F"
+    
+    '---------------------get price list------------------------------------------------------------------------
+    If pricelevel.chbNURSERY Then
+        pln = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "', '^N')", False, 2000, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5030;Database=ubm")
+        If pln(0, 0) <> "Product" Then
+            MsgBox (pln(0, 0))
+            Exit Sub
+        End If
+        If UBound(pln, 2) > 21 Then
+            segment_regex = "^F|^G"
+            Set nnws = nwb.Sheets.Add(, nws)
+            nnws.Name = "Price List - Nursery"
+            Call paste_pretty(pln, nnws, effdate)
+        End If
+    End If
+    
+    If pricelevel.chbFIBER Then
+        plf = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','^F')", False, 2000, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5030;Database=ubm")
+        If plf(0, 0) <> "Product" Then
+            MsgBox (plf(0, 0))
+            Exit Sub
+        End If
+        If UBound(plf, 2) > 21 Then
+            If segment_regex = "^F|^G" Then
+                segment_regex = "^G"
+            Else
+                segment_regex = "^G|^N"
+            End If
+            Set nfws = nwb.Sheets.Add(, nws)
+            nfws.Name = "Price List - Fiber"
+            Call paste_pretty(plf, nfws, effdate)
+        End If
+    End If
+    
+    pl = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','" & segment_regex & "')", 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
+    If UBound(pl, 2) > 21 Then
+        nws.Name = "Price list"
+        Call paste_pretty(pl, nws, effdate)
+    Else
+        nws.Delete
+    End If
+    
+    Application.ScreenUpdating = True
+    
+    '--------------------save file--------------------------------------------------------------------------------
+    'Dim fd As Object
+    'Set fd = Application.FileDialog(msoFileDialogFolderPicker)
+    'fd.Show
+    'If fd.SelectedItems.Count = 0 Then Exit Sub
+    With CreateObject("Scripting.FileSystemObject")
+        If Not .FolderExists(filepath) Then .CreateFolder filepath
+    End With
+    Application.DisplayAlerts = True
+    nwb.Activate
+    
+    Dim wb As Workbook
+    For Each wb In Workbooks
+        If wb.Name = "HC Companies Distributor Price List.xlsx" Then
+            If MsgBox("already have a price list open, close it?", vbOKCancel) Then
+                Workbooks("HC Companies Distributor Price List.xlsx").Close
+                Exit For
+            Else
+                Exit Sub
+            End If
+        End If
+    Next wb
+    
+    If pricelevel.tbPATH.text <> "" Then 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
+    
+    If Not (fcwb Is Nothing) Then
+        If pricelevel.tbPATH.text <> "" Then fcwb.SaveAs Filename:=filepath & "\HC FullCode List.xlsx"
+    End If
+
+    
+End Sub
+
+Sub paste_pretty(ByRef pl() As String, ByRef nws As Worksheet, ByVal effdate As Date)
+
+    Dim c As Range
+    Dim i As Long
+    Dim last As Long
+    Dim lastcol As Long
+    Dim j As Long
+    Dim curr As String
+
     nws.Activate
     nws.Cells.NumberFormat = "@"
     '---------------------format to numeric if selected---------------------------------------------------------
     If pricelevel.cbNUMERIC Then
-        Call x.SHTp_Dump(pl, nws.Name, 1, 1, False, True, 9, 12, 15, 10, 13, 16)
+        Call tbo.SHTp_Dump(pl, nws.Name, 1, 1, False, True, 9, 12, 15, 10, 13, 16)
-        Rows("1:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
+        nws.Rows("1:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
         nws.Columns(10).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""???_);_(@_)"
         nws.Columns(13).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""???_);_(@_)"
         nws.Columns(16).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""???_);_(@_)"
@@ -602,7 +697,7 @@ Sub build_customer_files()
         nws.Columns(16).ColumnWidth = 13
         nws.Rows(5).NumberFormat = "@"
     Else
-        Call x.SHTp_Dump(pl, nws.Name, 5, 1, False, True)
+        Call tbo.SHTp_Dump(pl, nws.Name, 5, 1, False, True)
         nws.Columns(10).ColumnWidth = 10.57
         nws.Columns(13).ColumnWidth = 10.57
         nws.Columns(16).ColumnWidth = 10.57
@@ -729,9 +824,9 @@ Sub build_customer_files()
     Next i
     
     '--------------------print header data--------------------------------------------------------------------------
-    pl = x.TBLp_Transpose(pl)
+    pl = tbo.TBLp_Transpose(pl)
-    Call x.TBLp_FilterSingle(pl, 20, "", False)
+    Call tbo.TBLp_FilterSingle(pl, 20, "", False)
-    Call x.TBLp_Group(pl, True, x.ARRAYp_MakeInteger(20))
+    Call tbo.TBLp_Group(pl, True, tbo.ARRAYp_MakeInteger(20))
     If UBound(pl, 2) > 1 Then
         '---somehow multiple currencies involved----
         MsgBox ("multiple currencies")
@@ -747,52 +842,12 @@ Sub build_customer_files()
         End Select
     End If
     nws.Cells(2, 3).value = "Distributor Price List (" & curr & ") - Effective " & Format(effdate, "MM/DD/YYYY")
-    nws.Name = "Price List"
     nws.Cells(5, 1).Select
     
     Call print_setup(nws, last)
     
     nws.Columns("R:V").Delete
 
-    Application.ScreenUpdating = True
-    
-    '--------------------save file--------------------------------------------------------------------------------
-    'Dim fd As Object
-    'Set fd = Application.FileDialog(msoFileDialogFolderPicker)
-    'fd.Show
-    'If fd.SelectedItems.Count = 0 Then Exit Sub
-    With CreateObject("Scripting.FileSystemObject")
-        If Not .FolderExists(filepath) Then .CreateFolder filepath
-    End With
-    Application.DisplayAlerts = True
-    nwb.Activate
-    
-    Dim wb As Workbook
-    For Each wb In Workbooks
-        If wb.Name = "HC Companies Distributor Price List.xlsx" Then
-            If MsgBox("already have a price list open, close it?", vbOKCancel) Then
-                Workbooks("HC Companies Distributor Price List.xlsx").Close
-                Exit For
-            Else
-                Exit Sub
-            End If
-        End If
-    Next wb
-    
-    If pricelevel.tbPATH.text <> "" Then 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
-    
-    If pricelevel.tbPATH.text <> "" Then fcwb.SaveAs Filename:=filepath & "\HC FullCode List.xlsx"
 
 
 End Sub