add functionality to display basket

TheBigOne.cls

@@ -16,7 +16,7 @@ Public ADOo_errstring As String
 Public Enum ADOinterface
     MicrosoftJetOLEDB4 = 0
     MicrosoftACEOLEDB12 = 1
-    SQLServer = 2
+    SqlServer = 2
     SQLServerNativeClient = 3
     SQLServerNativeClient10 = 4
     OracleODBC = 5
@@ -28,7 +28,7 @@ End Enum
 
 Public Enum SQLsyntax
     Db2 = 0
-    SQLServer = 1
+    SqlServer = 1
     PostgreSQL = 2
 End Enum
 
@@ -396,7 +396,33 @@ Sub SHTp_Dump(ByRef tbl() As String, ByRef sheet As String, ByRef row As Long, B
     If clear Then sh.Cells.clear
     If transpose Then Call Me.ARRAYp_Transpose(tbl)
     
-    sh.range(sh.Cells(row, col).Address & ":" & sh.Cells(row + UBound(tbl, 1), col + UBound(tbl, 2)).Address).FormulaR1C1 = tbl
+    sh.Range(sh.Cells(row, col).Address & ":" & sh.Cells(row + UBound(tbl, 1), col + UBound(tbl, 2)).Address).FormulaR1C1 = tbl
+    
+    On Error GoTo errhndl
+
+    If UBound(NumFields()) <> -1 Then
+        Dim i As Integer
+        i = 0
+        For i = 0 To UBound(NumFields())
+            Call sh.Columns(NumFields(i) + 1).TextToColumns
+        Next i
+    End If
+    
+errhndl:
+    If Err.Number <> 0 Then MsgBox ("Error in dumping to sheet" & vbCrLf & Err.Description)
+    
+
+End Sub
+
+Sub SHTp_DumpVar(ByRef tbl() As Variant, ByRef sheet As String, ByRef row As Long, ByRef col As Long, ByRef clear As Boolean, ByRef transpose As Boolean, ParamArray NumFields())
+
+    Dim sh As Worksheet
+    Set sh = Sheets(sheet)
+    
+    'If clear Then sh.Cells.clear
+    'If transpose Then Call Me.ARRAYp_Transpose(tbl)
+    
+    sh.Range(sh.Cells(row, col).Address & ":" & sh.Cells(row + UBound(tbl, 1), col + UBound(tbl, 2)).Address).FormulaR1C1 = tbl
     
     On Error GoTo errhndl
 
@@ -416,19 +442,19 @@ End Sub
 
 Sub ARRAYp_Transpose(ByRef a() As String)
 
-    Dim s() As String
+    Dim S() As String
-    ReDim s(UBound(a, 2), UBound(a, 1))
+    ReDim S(UBound(a, 2), UBound(a, 1))
     
     Dim i As Long
     Dim j As Long
     
-    For i = 0 To UBound(s, 1)
+    For i = 0 To UBound(S, 1)
-        For j = 0 To UBound(s, 2)
+        For j = 0 To UBound(S, 2)
-            s(i, j) = a(j, i)
+            S(i, j) = a(j, i)
         Next j
     Next i
 
-    a = s
+    a = S
 
 End Sub
 
@@ -473,6 +499,7 @@ errhdnl:
 
 End Function
 
+
 Public Sub TBLp_FilterSingle(ByRef table() As String, ByRef column As Long, ByVal Filter As String, ByVal Equals As Boolean)
 
 
@@ -529,8 +556,8 @@ Function SQLp_RollingMonthList(ByRef mmmyy As String, ByRef outformat As String,
     
     Dim i As Integer
     
-    cmn = Format(DateValue(Left(mmmyy, 3) & "-01-" & Right(mmmyy, 2)), "m")
+    cmn = Format(DateValue(left(mmmyy, 3) & "-01-" & right(mmmyy, 2)), "m")
-    cy = Right(mmmyy, 2)
+    cy = right(mmmyy, 2)
     
     For i = 0 To monthcount - 1
         If i <> 0 Then mlist = mlist & ","
@@ -554,21 +581,21 @@ Sub TBLp_DeleteCols(ByRef tbl() As String, ByRef column() As Integer)
     Dim j As Long
     Dim m As Long
     Dim k As Long
-    Dim OK As Boolean
+    Dim ok As Boolean
     
     m = -1
     i = 0
     While i <= UBound(tbl, 1)
         k = 0
-        OK = True
+        ok = True
         Do While k <= UBound(column())
             If i = column(k) Then
-                OK = False
+                ok = False
                 Exit Do
             End If
             k = k + 1
         Loop
-        If OK = True Then
+        If ok = True Then
             m = m + 1
             j = 0
             While j <= UBound(tbl, 2)
@@ -1301,7 +1328,7 @@ Public Function MISCe_CompareDate(ByRef base As Date, ByRef compare As Date) As
 
 End Function
 
-Public Function ROWe_FindOnSorted(ByRef tbl() As String, ByRef range As Long, ByRef match As Boolean, ParamArray fldsvals()) As Long
+Public Function ROWe_FindOnSorted(ByRef tbl() As String, ByRef Range As Long, ByRef match As Boolean, ParamArray fldsvals()) As Long
     
     On Error GoTo errpath
     'has to be a lexicographically sorted table otherwise this evaluaiton will not be the same as the sort evaluaiton
@@ -1371,7 +1398,7 @@ Public Function ROWe_FindOnSorted(ByRef tbl() As String, ByRef range As Long, By
                     j = currow
                 End If
                 
-                range = i
+                Range = i
                 ROWe_FindOnSorted = j
                 match = True
                 Exit Function
@@ -1403,13 +1430,13 @@ End Function
 Public Function ROWp_CreateKey(ByRef tbl() As String, ByRef flds() As Integer, ByRef row As Long) As String
 
     Dim i As Integer
-    Dim s As String
+    Dim S As String
     
     For i = 0 To UBound(flds)
-        s = s & tbl(flds(i), row)
+        S = S & tbl(flds(i), row)
     Next i
     
-    ROWp_CreateKey = s
+    ROWp_CreateKey = S
 
 End Function
 
@@ -1438,7 +1465,7 @@ Public Function MISCp_msgbox_cancel(ByRef Message As String, Optional ByRef TITL
     MsgB.Caption = TITLE
     MsgB.tbMSG.ScrollBars = fmScrollBarsBoth
     MsgB.Show
-    MISC_msgbox_cancel = MsgB.Cancel
+    MISC_msgbox_cancel = MsgB.cancel
     Application.EnableCancelKey = xlInterrupt
 
 End Function
@@ -1594,7 +1621,7 @@ Sub SHTp_HyperlinkConvert(ByRef sheet As Worksheet, ByRef column As Integer, ByR
  Set sh = sheet
  i = startrow
     Do Until sh.Cells(i, column) = stopflag
-        Call sh.Hyperlinks.Add(sh.range(sh.Cells(i, column).Address), sh.Cells(i, column))
+        Call sh.Hyperlinks.Add(sh.Range(sh.Cells(i, column).Address), sh.Cells(i, column))
         i = i + 1
     Loop
 
@@ -1957,7 +1984,7 @@ Function TXTp_ParseCSVrow(ByRef csv() As String, row As Long, col As Integer) As
 End Function
 
 
-Function json_from_list(keys As range, values As range) As String
+Function json_from_list(keys As Range, values As Range) As String
 
     Dim json As String
     Dim i As Integer
@@ -1986,7 +2013,7 @@ Function json_from_list(keys As range, values As range) As String
 
 End Function
 
-Function json_concat(list As range) As String
+Function json_concat(list As Range) As String
     
         Dim json As String
         Dim i As Integer
@@ -2009,7 +2036,7 @@ Function json_concat(list As range) As String
 
 End Function
 
-Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, trim As Boolean, start As Long, ending As Long, ParamArray ftype()) As String
+Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, target As String, trim As Boolean, start As Long, ending As Long, ParamArray ftype()) As String
 
     
     Dim i As Long
@@ -2017,7 +2044,7 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, tri
     Dim sql As String
     Dim rec As String
     
-    sql = "INSERT INTO " & Target & " VALUES " & vbCrLf
+    sql = "INSERT INTO " & target & " VALUES " & vbCrLf
     For i = start To ending
         rec = ""
         If i <> start Then sql = sql & "," & vbCrLf
@@ -2142,7 +2169,7 @@ Public Function MISCe_MaxLng(ByRef base As Long, ByRef compare As Long) As Long
 
 End Function
 
-Public Function markdown_from_table(ByRef tbl() As Variant) As String
+Public Function markdown_from_table(ByRef tbl() As Variant, Optional number_format As String) As String
     
  
     
@@ -2163,6 +2190,7 @@ Public Function markdown_from_table(ByRef tbl() As Variant) As String
     '---build markdown table-----------
     For r = 1 To UBound(tbl, 1)
         If r = 2 Then
+            'If IsNumeric(tbl(r, c)) And Mid(tbl(r, c), 1, 1) <> 0 Then
             md = md & "|"
             For c = 1 To UBound(tbl, 2)
                 md = md & "---" & String(Me.MISCe_MaxInt(msl(c), 3) - 3, "-") & "|"
@@ -2180,9 +2208,10 @@ Public Function markdown_from_table(ByRef tbl() As Variant) As String
 
 End Function
 
-Public Function json_multirange(ByRef r As range) As String
 
-    Dim ar As range
+Public Function json_multirange(ByRef r As Range) As String
+
+    Dim ar As Range
     Dim r1() As Variant
     Dim r2() As Variant
     Dim rslt As String
@@ -2216,7 +2245,7 @@ Function markdown_whole_sheet(ByRef sh As Worksheet) As String
     Dim x As New TheBigOne
     Dim tbl() As Variant
        
-    tbl = sh.range("A1:CZ1000").FormulaR1C1
+    tbl = sh.Range("A1:CZ1000").FormulaR1C1
     
     For ic = 1 To UBound(tbl, 2)
         For ir = 1 To UBound(tbl, 1)
@@ -2227,13 +2256,13 @@ Function markdown_whole_sheet(ByRef sh As Worksheet) As String
         Next ir
     Next ic
                 
-    tbl = sh.range(sh.Cells(1, 1).Address & ":" & sh.Cells(mr, mc).Address).FormulaR1C1
+    tbl = sh.Range(sh.Cells(1, 1).Address & ":" & sh.Cells(mr, mc).Address).FormulaR1C1
     
     markdown_whole_sheet = Me.markdown_from_table(tbl)
 
 End Function
 
-Function MISCe_colnum_to_letter(ByRef x As Long) As String
+Function MISCe_col_to_letter(ByRef x As Long) As String
 
     If x > 26 Then
         MISCe_colnum_to_letter = Chr(x \ 26 + 64) & Chr((x / 26 - x \ 26) * 26 + 64)
@@ -2243,6 +2272,7 @@ Function MISCe_colnum_to_letter(ByRef x As Long) As String
 
 End Function
 
+
 Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, headers As Boolean, syntax As SQLsyntax) As String
 
     
@@ -2333,7 +2363,7 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
     Select Case syntax
         Case SQLsyntax.Db2
             sql = "SELECT * FROM TABLE( VALUES" & vbCrLf & sql & vbCrLf & ") x"
-        Case SQLsyntax.SQLServer
+        Case SQLsyntax.SqlServer
             sql = "SELECT * FROM (VALUES" & vbCrLf & sql & vbCrLf & ") x"
         Case SQLsyntax.PostgreSQL
             sql = "SELECT * FROM (VALUES" & vbCrLf & sql & vbCrLf & ") x"
@@ -2345,7 +2375,7 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
 
 End Function
 
-Public Function ARRAYp_get_range_string(ByRef r As range) As String()
+Public Function ARRAYp_get_range_string(ByRef r As Range) As String()
 
     Dim i As Long
     Dim j As Long
@@ -2374,3 +2404,87 @@ Public Function ARRAYp_get_range_string(ByRef r As range) As String()
 
 End Function
 
+Public Function TBLp_range(ByRef dump() As Variant, ByVal upperleft As Range) As Range
+
+    width As Long
+    width = UBound(dump, 2)
+    Dim newcol As String
+    newcol = ConvertBase10(upperleft.column + UBound(dump, 2), "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+    
+    
+
+End Function
+
+Public Function Misc_ConvBase10(ByVal d As Double, ByVal sNewBaseDigits As String) As String
+'credit: http://www.freevbcode.com/ShowCode.asp?ID=6604
+
+    Dim S As String, tmp As Double, i As Integer, lastI As Integer
+    Dim BaseSize As Integer
+    BaseSize = Len(sNewBaseDigits)
+    Do While val(d) <> 0
+        tmp = d
+        i = 0
+        Do While tmp >= BaseSize
+            i = i + 1
+            tmp = tmp / BaseSize
+        Loop
+        If i <> lastI - 1 And lastI <> 0 Then S = S & String(lastI - i - 1, left(sNewBaseDigits, 1)) 'get the zero digits inside the number
+        tmp = Int(tmp) 'truncate decimals
+        S = S + Mid(sNewBaseDigits, tmp + 1, 1)
+        d = d - tmp * (BaseSize ^ i)
+        lastI = i
+    Loop
+    S = S & String(i, left(sNewBaseDigits, 1)) 'get the zero digits at the end of the number
+    Misc_ConvBase10 = S
+End Function
+
+Public Function SHTp_get_block(point As Range) As Variant()
+
+    Dim left As Long
+    Dim right As Long
+    Dim top As Long
+    Dim bot As Long
+    Dim i As Long
+    Dim lcol As String
+    Dim rcol As String
+    Dim r As Range
+    
+    
+    i = 0
+    Do Until point.Worksheet.Cells(point.row, point.column + i) = ""
+        i = i + 1
+    Loop
+    If i <> 0 Then i = i - 1
+    right = point.column + i
+    
+    i = 0
+    Do Until point.Worksheet.Cells(point.row, point.column + i) = ""
+        i = i - 1
+    Loop
+    If i <> 0 Then i = i + 1
+    left = point.column + i
+    
+    i = 0
+    Do Until point.Worksheet.Cells(point.row + i, point.column) = ""
+        i = i + 1
+    Loop
+    If i <> 0 Then i = i - 1
+    bot = point.row + i
+    
+    i = 0
+    Do Until point.Worksheet.Cells(point.row + i, point.column) = ""
+        i = i - 1
+        If point.row + i < 1 Then Exit Do
+    Loop
+    If i <> 0 Then i = i + 1
+    top = point.row + i
+    
+    lcol = Me.Misc_ConvBase10(left - 1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+    rcol = Me.Misc_ConvBase10(right - 1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+    
+    Set r = Worksheets("_month").Range(lcol & top & ":" & rcol & bot)
+    SHTp_get_block = r
+
+End Function
+
+

fpvt.frm

@@ -23,6 +23,7 @@ Private clear_lb As Boolean
 Private load_tb As Boolean
 Private set_Price As Boolean
 Private sp As Object
+Private basket() As Variant
 
 Private bVol As Double
 Private bVal As Double
@@ -366,7 +367,41 @@ Private Sub UserForm_Activate()
     month(0, 8) = "2020 val"
     
     Me.crunch_array
-    Call handler.month_tosheet(month)
+    
+    ReDim basket(sp("package")("basket").Count, 4)
+    
+'    basket(0, 0) = "order_season"
+'    basket(0, 1) = "order_month"
+'    basket(0, 2) = "version"
+'    basket(0, 3) = "iter"
+'    basket(0, 4) = "part_descr"
+'    basket(0, 5) = "bill_cust_descr"
+'    basket(0, 6) = "ship_cust_descr"
+'    basket(0, 7) = "units"
+'    basket(0, 8) = "value_usd"
+    basket(0, 0) = "part_descr"
+    basket(0, 1) = "bill_cust_descr"
+    basket(0, 2) = "ship_cust_descr"
+    basket(0, 3) = "mix"
+    
+    
+    For i = 1 To UBound(basket, 1)
+        'basket(i, 0) = sp("package")("base")(i)("order_season")
+        'basket(i, 1) = sp("package")("base")(i)("order_month")
+        'basket(i, 2) = sp("package")("base")(i)("version")
+        'basket(i, 3) = sp("package")("base")(i)("iter")
+        'basket(i, 4) = sp("package")("base")(i)("part_descr")
+        'basket(i, 5) = sp("package")("base")(i)("bill_cust_descr")
+        'basket(i, 6) = sp("package")("base")(i)("ship_cust_descr")
+        'basket(i, 7) = sp("package")("base")(i)("units")
+        'basket(i, 8) = sp("package")("base")(i)("value_usd")
+        basket(i, 0) = sp("package")("basket")(i)("part_descr")
+        basket(i, 1) = sp("package")("basket")(i)("bill_cust_descr")
+        basket(i, 2) = sp("package")("basket")(i)("ship_cust_descr")
+        basket(i, 3) = sp("package")("basket")(i)("mix")
+    Next i
+    
+    Call handler.month_tosheet(month, basket)
     Application.StatusBar = False
     
 End Sub

handler.bas

@@ -52,6 +52,7 @@ Function scenario_package(doc As String, ByRef status As Boolean) As Object
     On Error GoTo errh
     
     With req
+        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
         .Open "GET", server & "/scenario_package", True
         .SetRequestHeader "Content-Type", "application/json"
         .Send doc
@@ -334,10 +335,11 @@ Sub load_config()
     
 End Sub
 
-Sub month_tosheet(ByRef pkg() As Variant)
+Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
 
     Dim j As Object
     Dim i As Integer
+    Dim r As Long
     Dim sh As Worksheet
     Set sh = Sheets("_month")
     
@@ -406,12 +408,24 @@ Sub month_tosheet(ByRef pkg() As Variant)
                 sh.Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4)
             End If
             
-            '--json--
-            
         End If
         
     Next i
     
+    'scenario
+    For i = 0 To UBound(handler.sc, 1)
+        sh.Cells(i + 1, 18) = handler.sc(i, 0)
+        sh.Cells(i + 1, 19) = handler.sc(i, 1)
+    Next i
+    
+    'basket
+    sh.Range("U1:Y100000").ClearContents
+    For i = 0 To UBound(basket, 2)
+        For r = 0 To UBound(basket, 1)
+            sh.Cells(r + 1, i + 21) = basket(r, i)
+        Next r
+    Next i
+    
     months.load_sheet
     
 End Sub
@@ -425,3 +439,5 @@ Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
     End If
 
 End Function
+
+

months.cls

@@ -22,6 +22,8 @@ Private adjust() As Object
 Private jtext() As Variant
 Private basejson As Object
 Private rollback As Boolean
+Private scenario() As Variant
+Private orig As Range
 
 
 
@@ -38,6 +40,8 @@ Private Sub Worksheet_Change(ByVal target As Range)
             Exit Sub
         End If
         
+
+
         If Not Intersect(target, Range("E6:E17")) Is Nothing Then Call Me.mvp_adj
         If Not Intersect(target, Range("F6:F17")) Is Nothing Then Call Me.mvp_set
         If Not Intersect(target, Range("K6:K17")) Is Nothing Then Call Me.mvp_adj
@@ -63,7 +67,11 @@ Sub mvp_set()
         units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
         price(i, 4) = price(i, 5) - (price(i, 2) + price(i, 3))
         sales(i, 5) = units(i, 5) * price(i, 5)
-        sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
+        If units(i, 4) = 0 And price(i, 4) = 0 Then
+            sales(i, 4) = 0
+        Else
+            sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
+        End If
         Call Me.build_json(i)
     Next i
     
@@ -84,7 +92,11 @@ Sub mvp_adj()
         units(i, 5) = units(i, 4) + (units(i, 2) + units(i, 3))
         price(i, 5) = price(i, 4) + (price(i, 2) + price(i, 3))
         sales(i, 5) = units(i, 5) * price(i, 5)
-        sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
+        If units(i, 4) = 0 And price(i, 4) = 0 Then
+            sales(i, 4) = 0
+        Else
+            sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
+        End If
         Call Me.build_json(i)
     Next i
     
@@ -102,6 +114,7 @@ Sub ms_set()
     vp = Sheets("month").Range("R2")
 
     For i = 1 To 12
+        If sales(i, 5) = "" Then sales(i, 5) = 0
         If Round(sales(i, 5) - (sales(i, 2) + sales(i, 3)), 6) <> Round(sales(i, 4), 6) Then
             sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
             Select Case vp
@@ -154,6 +167,7 @@ Sub ms_adj()
     vp = Sheets("month").Range("R2")
 
     For i = 1 To 12
+        If sales(i, 4) = "" Then sales(i, 4) = 0
         If Round(sales(i, 5), 6) <> Round(sales(i, 2) + sales(i, 3) + sales(i, 4), 6) Then
             sales(i, 5) = sales(i, 4) + sales(i, 2) + sales(i, 3)
             Select Case vp
@@ -226,19 +240,29 @@ Sub set_sheet()
     Range("B18:F18").FormulaR1C1 = tunits
     Range("H18:L18").FormulaR1C1 = tprice
     Range("N18:R18").FormulaR1C1 = tsales
+    Range("T6:U18").FormulaR1C1 = scenario
+    
+    Sheets("month").Range("B32:Q5000").ClearContents
     
     For i = 1 To 12
         Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
     Next i
+    
+    ActiveWindow.FreezePanes = False
+    
+    Rows("19:32").Hidden = False
+    
     dumping = False
     
 End Sub
 
 Sub load_sheet()
 
+
     units = Sheets("_month").Range("A2:E13").FormulaR1C1
     price = Sheets("_month").Range("F2:J13").FormulaR1C1
     sales = Sheets("_month").Range("K2:O13").FormulaR1C1
+    scenario = Sheets("_month").Range("R1:S13").FormulaR1C1
     tunits = Range("B18:F18")
     tprice = Range("H18:L18")
     tsales = Range("N18:R18")
@@ -246,6 +270,8 @@ Sub load_sheet()
     Me.crunch_array
     Me.set_sheet
     
+    
+
 End Sub
 
 Sub set_format()
@@ -369,7 +395,7 @@ End Sub
 Sub build_json(ByVal pos As Integer)
 
     'if something is changing
-    If Round(units(pos, 4), 2) <> 0 Or Round(price(pos, 4), 8) <> 0 Or Round(sales(pos, 4), 8) <> 0 Then
+    If Round(units(pos, 4), 2) <> 0 Or (Round(price(pos, 4), 8) <> 0 And Round(units(pos, 5), 2) <> 0) Then
         Set adjust(pos) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(basejson))
         'if there is no existing volume on the target month but units are being added
         If units(pos, 2) + units(pos, 3) = 0 And units(pos, 4) <> 0 Then
@@ -445,4 +471,42 @@ Sub reset()
 
     Call Me.load_sheet
 
+    
+End Sub
+
+Sub show_basket()
+
+    Dim i As Long
+    Dim basket() As Variant
+    basket = x.SHTp_get_block(Sheets("_month").Range("U1"))
+    
+    dumping = True
+    
+    Application.ScreenUpdating = False
+    
+    Set orig = Selection
+    
+    ActiveWindow.FreezePanes = False
+    
+    
+    For i = 1 To UBound(basket, 1) - 1
+        Sheets("month").Cells(32 + i, 2) = basket(i + 1, 1)
+        Sheets("month").Cells(32 + i, 6) = basket(i + 1, 2)
+        Sheets("month").Cells(32 + i, 12) = basket(i + 1, 3)
+        Sheets("month").Cells(32 + i, 17) = basket(i + 1, 4)
+    Next i
+    
+    Rows("20:20").Select
+    ActiveWindow.FreezePanes = True
+    
+    Rows("20:31").Select
+    Selection.EntireRow.Hidden = True
+    
+    orig.Select
+    
+    Application.ScreenUpdating = True
+    
+    dumping = False
+    
+
 End Sub