finalize to get 1.5 done

This commit is contained in:
pt 2020-03-13 17:31:48 -04:00
parent 7182502669
commit 64c7be2587
8 changed files with 116 additions and 7 deletions

View File

@ -67,9 +67,12 @@ Private Sub UserForm_Activate()
cbBill.value = bill
cbShip.value = ship
cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
cbBill.list = Application.transpose(Worksheets("mdata").Range("D2:D14295"))
cbShip.list = Application.transpose(Worksheets("mdata").Range("D2:D14295"))
cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A2").CurrentRegion)
'cbPart.list(1).Remove
cbBill.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
'cbPart.list(1).Remove
cbShip.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
'cbPart.list(1).Remove
End Sub

BIN
build.frx

Binary file not shown.

View File

@ -38,8 +38,6 @@ Private Sub lbHist_Change()
Exit Sub
End If
Next i
End Sub

Binary file not shown.

112
fpvt.frm
View File

@ -24,11 +24,14 @@ Private load_tb As Boolean
Private set_Price As Boolean
Private sp As Object
Private basket() As Variant
Private cust() 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 cswap As Object
Private cust_s() As Boolean
Private bVol As Double
Private bVal As Double
@ -169,7 +172,6 @@ Private Sub cbTAG_Change()
End Sub
Private Sub lbMonth_Change()
If clear_lb Or load_tb Then Exit Sub
@ -738,6 +740,20 @@ Private Sub UserForm_Activate()
basket(i, 3) = sp("package")("basket")(i)("mix")
Next i
'---------------get list of customers----------------------------
ReDim cust(sp("package")("customers").Count - 1, 3)
For i = 0 To UBound(cust, 1)
cust(i, 0) = sp("package")("customers")(i + 1)("bill_cust_descr")
cust(i, 1) = ""
cust(i, 2) = sp("package")("customers")(i + 1)("ship_cust_descr")
cust(i, 3) = ""
Next i
Call x.frmListBoxHeader(lbCUSTH, lbCUST, "Bill-To", "Replace", "Ship-To", "Replace")
'-------------load tags-------------------------------
If Not IsNull(sp("package")("tags")) Then
@ -760,7 +776,10 @@ Private Sub UserForm_Activate()
lbSWAP.clear
pickSWAP.value = ""
pickSWAP.text = Mid(sp("package")("basket")(1)("part_descr"), 1, 8)
pickSWAP.list = Application.transpose(Worksheets("mdata").Range("F2:F1112"))
pickSWAP.list = Application.transpose(Worksheets("mdata").Range("F2:F2").CurrentRegion)
cbBT.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
cbST.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
lbCUST.list = cust
Call x.frmListBoxHeader(Me.lbSWAPH, Me.lbSWAP, "Original", "Sales", "Replacement", "Fit")
'---------price volume radio button colors----------
@ -824,6 +843,95 @@ Sub crunch_array()
End Sub
Private Sub lbCUST_Change()
Dim i As Long
Dim x() As Variant
x = lbCUST.list
For i = 0 To UBound(x, 1)
If lbCUST.Selected(i) Then Exit For
Next i
cbBT.text = x(i, 0)
cbST.text = x(i, 2)
End Sub
Private Sub cbBT_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode <> 13 Then Exit Sub
Dim i As Long
Dim x() As Variant
x = lbCUST.list
For i = 0 To UBound(x, 1)
If lbCUST.Selected(i) Then x(i, 1) = Me.rev_cust(cbBT.text)
Next i
lbCUST.list = x
Call Me.build_cust_swap
End Sub
Private Sub cbST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode <> 13 Then Exit Sub
Dim i As Long
Dim x() As Variant
x = lbCUST.list
For i = 0 To UBound(x, 1)
If lbCUST.Selected(i) Then x(i, 3) = Me.rev_cust(cbST.text)
Next i
lbCUST.list = x
Call Me.build_cust_swap
End Sub
Sub build_cust_swap()
Dim vtable() As Variant
Dim ptable As String
vtable = lbCUST.list
vtable = x.ARRAYp_TransposeVar(vtable)
vtable = x.ARRAYp_zerobased_addheader(vtable, "bill", "bill_r", "ship", "ship_r")
vtable = x.ARRAYp_TransposeVar(vtable)
ptable = x.json_from_table_zb(vtable, "rows", True, False)
Set cswap = JsonConverter.ParseJson("{""scenario"":" & handler.scenario & "}")
cswap("scenario")("version") = handler.plan
cswap("scenario")("iter") = handler.basis
cswap("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
cswap("user") = Application.UserName
cswap("source") = "adj"
cswap("message") = tbCOM.text
cswap("tag") = cbTAG.text
cswap("type") = "cust_swap"
Set cswap("swap") = JsonConverter.ParseJson(ptable)
tbAPI.text = JsonConverter.ConvertToJson(cswap)
End Sub
Public Function rev_cust(cust As String) As String
If cust = "" Then
rev_cust = ""
Exit Function
End If
If InStr(1, cust, " - ") <= 9 Then
rev_cust = trim(Mid(cust, 11, 100)) & " - " & trim(Left(cust, 8))
Else
rev_cust = trim(Right(cust, 8)) & " - " & Mid(cust, 1, InStr(1, cust, " - "))
End If
End Function
Sub load_var()
'base

BIN
fpvt.frx

Binary file not shown.

BIN
openf.frx

Binary file not shown.

BIN
part.frx

Binary file not shown.