add a new route for swapping out parts

This commit is contained in:
Trowbridge 2020-03-05 01:08:10 -05:00
parent f569e6238d
commit 7e57d4621f
10 changed files with 374 additions and 49 deletions

View File

@ -459,6 +459,43 @@ Sub ARRAYp_Transpose(ByRef a() As String)
End Sub
Function ARRAYp_TransposeVar(ByRef a() As Variant) As Variant()
Dim s() As Variant
ReDim s(UBound(a, 2), UBound(a, 1))
Dim i As Long
Dim j As Long
For i = 0 To UBound(s, 1)
For j = 0 To UBound(s, 2)
s(i, j) = a(j, i)
Next j
Next i
ARRAYp_TransposeVar = s
End Function
Function ARRAYp_zerobased_addheader(ByRef z() As Variant, ParamArray cols()) As Variant()
Dim i As Long
Dim j As Long
Dim r() As Variant
ReDim r(UBound(z, 1), UBound(z, 2) + 1)
For i = 0 To UBound(r, 1)
For j = 1 To UBound(r, 2)
r(i, j) = z(i, j - 1)
Next j
r(i, 0) = cols(i)
Next i
ARRAYp_zerobased_addheader = r
End Function
Public Function SHTp_Get(ByRef sheet As String, ByRef row As Long, ByRef col As Long, ByRef headers As Boolean) As String()
@ -1461,11 +1498,11 @@ End Function
Public Function MISCp_msgbox_cancel(ByRef Message As String, Optional ByRef TITLE As String = "") As Boolean
Application.EnableCancelKey = xlDisabled
MsgB.tbMSG.Text = Message
MsgB.tbMSG.text = Message
MsgB.Caption = TITLE
MsgB.tbMSG.ScrollBars = fmScrollBarsBoth
MsgB.Show
MISC_msgbox_cancel = MsgB.cancel
MISC_msgbox_cancel = MsgB.Cancel
Application.EnableCancelKey = xlInterrupt
End Function
@ -2037,7 +2074,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
@ -2045,7 +2082,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
@ -2151,6 +2188,70 @@ Public Function json_from_table(ByRef tbl() As Variant, ByRef array_label As Str
End Function
Public Function json_from_table_zb(ByRef tbl() As Variant, ByRef array_label As String, Optional strip_braces As Boolean) As String
Dim ajson As String
Dim json As String
Dim r As Integer
Dim c As Integer
Dim needs_comma As Boolean
Dim needs_braces As Integer
needs_comma = False
needs_braces = 0
ajson = ""
For r = 1 To UBound(tbl, 1)
For c = 0 To UBound(tbl, 2)
If tbl(r, c) <> "" Then
needs_braces = needs_braces + 1
If needs_comma Then json = json & ","
needs_comma = True
If IsNumeric(tbl(r, c)) And Mid(tbl(r, c), 1, 1) <> 0 Then
json = json & Chr(34) & tbl(0, c) & Chr(34) & ":" & tbl(r, c)
Else
'test if item is a json object
If Mid(tbl(r, c), 1, 1) = "{" Or Mid(tbl(r, c), 1, 1) = "[" Then
json = json & """" & tbl(0, c) & """" & ":" & tbl(r, c)
Else
json = json & Chr(34) & tbl(0, c) & Chr(34) & ":" & Chr(34) & tbl(r, c) & Chr(34)
End If
End If
End If
Next c
If needs_braces > 0 Then json = "{" & json & "}"
needs_comma = False
needs_braces = 0
If r > 1 Then
ajson = ajson & "," & json
Else
ajson = json
End If
json = ""
Next r
'if theres more the one record, include brackets for array
'if an array_label is given give the array a key and the array become the value
'then if the array is labeled with a key it should have braces unless specified otherwise
If r > 2 Then
ajson = "[" & ajson & "]"
If array_label <> "" Then
ajson = """" & array_label & """:" & ajson
If Not strip_braces Then
ajson = "{" & ajson & "}"
End If
End If
Else
If strip_braces Then
ajson = Mid(ajson, 2, Len(ajson) - 2)
End If
End If
json_from_table_zb = ajson
End Function
Public Function MISCe_MaxLng(ByRef base As Long, ByRef compare As Long) As Long
If compare < base Then
@ -2444,7 +2545,7 @@ Public Function Misc_ConvBase10(ByVal d As Double, ByVal sNewBaseDigits As Strin
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
Do While val(d) <> 0
tmp = d
i = 0
Do While tmp >= BaseSize
@ -2598,3 +2699,32 @@ Function TBLp_VarToString(ByRef t() As Variant) As String()
TBLp_VarToString = x
End Function
Sub frmListBoxHeader(ByRef hdr As MSForms.listbox, ByRef det As MSForms.listbox, ParamArray cols())
Dim i As Long
hdr.ColumnCount = det.ColumnCount
hdr.ColumnWidths = det.ColumnWidths
' add header elements
hdr.clear
hdr.AddItem
For i = 0 To UBound(cols, 1)
hdr.list(0, i) = cols(i)
Next i
' make it pretty
'body.ZOrder (1)
'lbHEAD.ZOrder (0)
hdr.SpecialEffect = fmSpecialEffectFlat
'hdr.BackColor = RGB(200, 200, 200)
hdr.Height = 10
' align header to body (should be done last!)
hdr.width = det.width
hdr.Left = det.Left
hdr.Top = det.Top - (hdr.Height - 1)
End Sub

View File

@ -13,7 +13,7 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private X As Variant
Private x As Variant
Private Sub cbCancel_Click()
@ -34,7 +34,7 @@ Private Sub lbHist_Change()
For i = 0 To Me.lbHist.ListCount - 1
If Me.lbHist.Selected(i) Then
Me.tbPrint.value = X(i, 7)
Me.tbPrint.value = x(i, 7)
Exit Sub
End If
Next i
@ -68,12 +68,12 @@ Private Sub UserForm_Activate()
Dim fail As Boolean
'x = handler.list_changes("{""user"":""" & Application.UserName & """}", fail)
X = handler.list_changes("{""quota_rep_descr"":""" & Sheets("data").Cells(2, 5) & """}", fail)
x = handler.list_changes("{""quota_rep_descr"":""" & Sheets("data").Cells(2, 5) & """}", fail)
If fail Then
Me.Hide
Exit Sub
End If
Me.lbHist.list = X
Me.lbHist.list = x
lbHEAD.ColumnCount = lbHist.ColumnCount
lbHEAD.ColumnWidths = lbHist.ColumnWidths
@ -88,10 +88,6 @@ Private Sub UserForm_Activate()
lbHEAD.list(0, 4) = "Comment"
lbHEAD.list(0, 5) = "Sales"
' make it pretty
'body.ZOrder (1)
'lbHEAD.ZOrder (0)
@ -120,7 +116,7 @@ Sub delete_selected()
For i = 0 To Me.lbHist.ListCount - 1
If Me.lbHist.Selected(i) Then
Call handler.undo_changes(X(i, 6), fail)
Call handler.undo_changes(x(i, 6), fail)
If fail Then
MsgBox ("undo did not work")
Exit Sub

Binary file not shown.

173
fpvt.frm
View File

@ -4,7 +4,7 @@ Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
ClientHeight = 8445.001
ClientLeft = 120
ClientTop = 465
ClientWidth = 8820.001
ClientWidth = 9285.001
OleObjectBlob = "fpvt.frx":0000
StartUpPosition = 1 'CenterOwner
End
@ -24,6 +24,11 @@ Private load_tb As Boolean
Private set_Price As Boolean
Private sp As Object
Private basket() As Variant
Private vSwap() As Variant
Private swapline As Integer
Private set_swapalt As Boolean
Private return_swap As Boolean
Private jswap As Object
Private bVol As Double
Private bVal As Double
@ -66,8 +71,9 @@ End Sub
Private Sub butAdjust_Click()
Dim fail As Boolean
Dim doc As String
If adjust("source") = "" Then
If tbAPI.text = "" Then
MsgBox ("No adjustments provided")
Exit Sub
End If
@ -77,7 +83,25 @@ Private Sub butAdjust_Click()
Exit Sub
End If
Call handler.request_adjust(JsonConverter.ConvertToJson(adjust), fail)
Select Case fpvt.mp.SelectedItem.Name
Case "pageSWAP"
doc = tbAPI.text
If doc = "" Then
MsgBox ("no part swap setup")
Exit Sub
End If
Case "pAnn"
doc = tbAPI.text
If doc = "" Then
MsgBox ("no adjustements are ready")
Exit Sub
End If
Case Else
MsgBox ("not on an adjustable tab")
Exit Sub
End Select
Call handler.request_adjust(doc, fail)
If fail Then
MsgBox ("adjustment was not made due to error")
Exit Sub
@ -132,19 +156,18 @@ Private Sub cbGoSheet_Click()
End Sub
Private Sub cbTAG_Change()
Dim j As Object
If tbAPI.text = "" Then tbAPI.text = "{}"
Set adjust = JsonConverter.ParseJson(tbAPI.text)
adjust("tag") = cbTAG.value
tbAPI.text = JsonConverter.ConvertToJson(adjust)
Set j = JsonConverter.ParseJson(tbAPI.text)
j("tag") = cbTAG.value
tbAPI.text = JsonConverter.ConvertToJson(j)
End Sub
Private Sub Label64_Click()
End Sub
Private Sub lbMonth_Change()
@ -181,10 +204,132 @@ Private Sub lbMonth_Change()
End Sub
Private Sub lheader_Click()
Private Sub cbPLIST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode <> 13 Then Exit Sub
Dim i As Long
If set_swapalt Then Exit Sub
Dim vtable() As Variant
Dim ptable As String
Dim rx As Object
Set rx = CreateObject("vbscript.regexp")
rx.Global = True
rx.Pattern = " - .*"
For i = 0 To Me.lbSWAP.ListCount - 1
If Me.lbSWAP.Selected(i) Then
vSwap(swapline, 2) = rx.Replace(cbPLIST.value, "")
return_swap = True
lbSWAP.list = vSwap
return_swap = False
End If
Next i
vtable = x.ARRAYp_TransposeVar(vSwap)
vtable = x.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit")
vtable = x.ARRAYp_TransposeVar(vtable)
ptable = x.json_from_table_zb(vtable, "rows", False)
Set jswap("swap") = JsonConverter.ParseJson(ptable)
jswap("scenario")("version") = handler.plan
jswap("scenario")("iter") = handler.basis
jswap("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
jswap("user") = Application.UserName
jswap("source") = "adj"
jswap("message") = tbCOM.text
jswap("tag") = cbTAG.text
jswap("type") = "swap"
tbAPI.text = JsonConverter.ConvertToJson(jswap)
End Sub
Private Sub dbGETSWAP_Click()
Dim doc As String
Dim j As Object
Dim fail As Boolean
Dim l() As Variant
Dim ptable As String
Dim vtable() As Variant
Set j = JsonConverter.ParseJson("{""scenario"":" & handler.scenario & "}")
'Set j = JsonConverter.ParseJson(doc)
j("new_mold") = pickSWAP.text
doc = JsonConverter.ConvertToJson(j)
vSwap = handler.get_swap_fit(doc, fail)
lbSWAP.list = vSwap
'Call x.frmListBoxHeader(lbSWAPH, lbSWAP, "Original", "Sales", "Replacement", "Fit")
cbPLIST.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
'---------build change-------------
Set jswap = j
vtable = x.ARRAYp_TransposeVar(vSwap)
vtable = x.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit")
vtable = x.ARRAYp_TransposeVar(vtable)
ptable = x.json_from_table_zb(vtable, "rows", False)
Set jswap("swap") = JsonConverter.ParseJson(ptable)
jswap("scenario")("version") = handler.plan
jswap("scenario")("iter") = handler.basis
jswap("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
jswap("user") = Application.UserName
jswap("source") = "adj"
jswap("message") = tbCOM.text
jswap("tag") = cbTAG.text
jswap("type") = "swap"
tbAPI.text = JsonConverter.ConvertToJson(jswap)
End Sub
Private Sub lbSWAP_Change()
Dim i As Long
If return_swap Then Exit Sub
For i = 0 To Me.lbSWAP.ListCount - 1
If Me.lbSWAP.Selected(i) Then
set_swapalt = True
cbPLIST.value = vSwap(i, 2)
set_swapalt = False
swapline = i
End If
Next i
End Sub
Private Sub lbSWAP_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
' Dim rx As Object
' Set rx = CreateObject("vbscript.regexp")
' rx.Global = True
' rx.Pattern = " - .*"
' Dim match As Object
' Dim i As Long
' Dim v As Variant
'
' 'v = Me.lbSWAP.list
'
' For i = 0 To Me.lbSWAP.ListCount - 1
' If Me.lbSWAP.Selected(i) Then
' part.Show
' If Not part.useval Then
' Exit Sub
' End If
' 'vSwap(i, 3) = rx.Execute(part.cbPart.value)
' 'v(i, 2) = rx.Replace(part.cbPart.value, "")
' 'Me.lbSWAP.list = v
' End If
' Next i
'
End Sub
Private Sub opEditPrice_Click()
opPlugVol.Enabled = False
@ -425,6 +570,7 @@ Private Sub UserForm_Activate()
Me.lheader = "Loading..."
Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
Call x.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection")
Me.lheader = "Ready"
@ -584,6 +730,13 @@ Private Sub UserForm_Activate()
sbpp.value = 0
sbpd.value = 0
'--------reset swap tab-------------------------------
lbSWAP.clear
pickSWAP.value = ""
pickSWAP.text = ""
pickSWAP.list = Application.transpose(Worksheets("mdata").Range("F2:F1672"))
Call x.frmListBoxHeader(Me.lbSWAPH, Me.lbSWAP, "Original", "Sales", "Replacement", "Fit")
Call handler.month_tosheet(month, basket)
Application.StatusBar = False

BIN
fpvt.frx

Binary file not shown.

View File

@ -5,7 +5,7 @@ Public sql As String
Public jsql As String
Public scenario As String
Public sc() As Variant
Public X As New TheBigOne
Public x As New TheBigOne
Public wapi As New Windows_API
Public data() As String
Public agg() As String
@ -26,7 +26,7 @@ Sub load_fpvt()
Dim i As Long
Dim s_tot As Object
fpvt.ListBox1.list = handler.sc
fpvt.lbSDET.list = handler.sc
showprice = False
@ -182,7 +182,7 @@ Sub pg_main_workset(rep As String)
ReDim str(UBound(res, 1), UBound(res, 2))
Worksheets("data").Cells.ClearContents
Call X.SHTp_DumpVar(res, "data", 1, 1, False, True, True)
Call x.SHTp_DumpVar(res, "data", 1, 1, False, True, True)
End Sub
@ -309,7 +309,7 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
i = i + 1
Loop
Call X.SHTp_DumpVar(res, "data", i, 1, False, False, True)
Call x.SHTp_DumpVar(res, "data", i, 1, False, False, True)
'Call x.SHTp_Dump(str, "data", CLng(i), 1, False, False, 28, 29, 30, 31, 32)
@ -453,8 +453,8 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
'basket
sh.Range("U1:AC100000").ClearContents
Call X.SHTp_DumpVar(basket, "_month", 1, 21, False, False, True)
Call X.SHTp_DumpVar(basket, "_month", 1, 26, False, False, True)
Call x.SHTp_DumpVar(basket, "_month", 1, 21, False, False, True)
Call x.SHTp_DumpVar(basket, "_month", 1, 26, False, False, True)
Sheets("config").Cells(5, 2) = 0
Sheets("config").Cells(6, 2) = 0
Sheets("config").Cells(7, 2) = 0
@ -589,3 +589,49 @@ Sub history()
changes.Show
End Sub
Function get_swap_fit(doc As String, ByRef fail As Boolean) As Variant()
Dim req As New WinHttp.WinHttpRequest
Dim json As Object
Dim wr As String
Dim i As Integer
Dim j As Integer
Dim res() As Variant
If doc = "" Then
fail = True
Exit Function
End If
server = Sheets("config").Cells(1, 2)
With req
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
.Open "GET", server & "/swap_fit", True
.SetRequestHeader "Content-Type", "application/json"
.Send doc
.WaitForResponse
wr = .ResponseText
End With
Set json = JsonConverter.ParseJson(wr)
If IsNull(json("x")) Then
MsgBox ("no history")
fail = True
Exit Function
End If
ReDim res(json("x").Count - 1, 3)
For i = 0 To UBound(res, 1)
res(i, 0) = json("x")(i + 1)("part")
res(i, 1) = json("x")(i + 1)("value_usd")
res(i, 2) = json("x")(i + 1)("swap")
res(i, 3) = json("x")(i + 1)("fit")
Next i
get_swap_fit = res
End Function

View File

@ -9,7 +9,7 @@ Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
Private X As New TheBigOne
Private x As New TheBigOne
Private units() As Variant
Private price() As Variant
Private sales() As Variant
@ -126,11 +126,11 @@ Private Sub Worksheet_Change(ByVal Target As Range)
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
cancel = True
Cancel = True
Call Me.basket_pick(Target)
Target.Select
End If
@ -146,10 +146,10 @@ Sub picker_shortcut()
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, cancel As Boolean)
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
cancel = True
Cancel = True
Call Me.basket_pick(Target)
Target.Select
End If
@ -361,7 +361,7 @@ Sub set_sheet()
Range("H18:L18").FormulaR1C1 = tprice
Range("N18:R18").FormulaR1C1 = tsales
Range("T6:U18").ClearContents
Call X.SHTp_DumpVar(X.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
'Sheets("month").Range("B32:Q5000").ClearContents
If Me.newpart Then
@ -388,7 +388,7 @@ Sub load_sheet()
tsales = Range("N18:R18")
'reset basket
Sheets("_month").Range("U1:X10000").ClearContents
Call X.SHTp_DumpVar(X.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
ReDim adjust(12)
Call Me.crunch_array
Call Me.set_sheet
@ -620,9 +620,9 @@ Sub build_json()
'np("basket") = x.json_from_table(b, "basket", False)
'get the basket from the sheet
b = Worksheets("_month").Range("U1").CurrentRegion.value
Set m = JsonConverter.ParseJson(X.json_from_table(b, "basket", False))
Set m = JsonConverter.ParseJson(x.json_from_table(b, "basket", False))
If UBound(b, 1) <= 2 Then
Set np("basket") = JsonConverter.ParseJson("[" & X.json_from_table(b, "basket", False) & "]")
Set np("basket") = JsonConverter.ParseJson("[" & x.json_from_table(b, "basket", False) & "]")
Else
Set np("basket") = m("basket")
End If
@ -687,7 +687,7 @@ Sub crunch_array()
End Sub
Sub cancel()
Sub Cancel()
Sheets("Orders").Select
@ -727,7 +727,7 @@ Sub print_basket()
Dim i As Long
Dim basket() As Variant
basket = X.SHTp_get_block(Sheets("_month").Range("U1"))
basket = x.SHTp_get_block(Sheets("_month").Range("U1"))
dumping = True
@ -840,7 +840,7 @@ Sub get_edit_basket()
dumping = False
Worksheets("_month").Range("U2:X5000").ClearContents
Call X.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
If Me.newpart Then
Me.build_json
@ -911,7 +911,7 @@ Sub build_new()
'Call Me.set_sheet
'Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
basket = X.SHTp_get_block(Worksheets("_month").Range("U1"))
basket = x.SHTp_get_block(Worksheets("_month").Range("U1"))
Sheets("month").Cells(32, 2) = basket(1, 1)
Sheets("month").Cells(32, 6) = basket(1, 2)
Sheets("month").Cells(32, 12) = basket(1, 3)
@ -934,8 +934,8 @@ Sub new_part()
'---------build customer mix-------------------------------------------------------------------
cust = X.SHTp_Get("_month", 1, 27, True)
If Not X.TBLp_Aggregate(cust, True, True, True, Array(0, 1), Array("S", "S"), Array(2)) Then
cust = x.SHTp_Get("_month", 1, 27, True)
If Not x.TBLp_Aggregate(cust, True, True, True, Array(0, 1), Array("S", "S"), Array(2)) Then
MsgBox ("error building customer mix")
End If
@ -979,8 +979,8 @@ Sub new_part()
i = i + 1
Loop
Worksheets("_month").Range("U2:AC10000").ClearContents
Call X.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
Call X.SHTp_DumpVar(b, "_month", 2, 26, False, False, True)
Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
Call x.SHTp_DumpVar(b, "_month", 2, 26, False, False, True)
'------reset volume to copy base to forecsat and clear base------------------------------------

BIN
openf.frx

Binary file not shown.

BIN
part.frx

Binary file not shown.

View File

@ -13,7 +13,7 @@ Private Sub Worksheet_Activate()
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, ActiveSheet.Range("b8:v100000")) Is Nothing Then
Exit Sub
@ -25,7 +25,7 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean
Exit Sub
End If
cancel = True
Cancel = True
Dim i As Long
Dim j As Long