This is where I have the fields defined.
Public Const gsBEV_TEMP_CARTOON_VALUES_COLUMN_START As String = "B"
Public Const gnBEV_TEMP_CARTOON_VALUES_ROW_START As Long = 116
Public Const gsBEV_TEMP_CARTOON_VALUES_COLUMN_END As String = "E"
Public Const gnBEV_TEMP_CARTOON_VALUES_ROW_END As Long = 132
Public Const gnBEV_FILLER_COUNTERPARTS As Long = 5
Public Const gsBEV_HIDDEN_PROD_START As String = "B"
Public Const gnBEV_HIDDEN_BLENDING_KETTLE_1_ROW As Long = 116
Public Const gnBEV_HIDDEN_BLENDING_KETTLE_2_ROW As Long = 117
Public Const gnBEV_HIDDEN_BLENDING_KETTLE_3_ROW As Long = 118
Public Const gnBEV_HIDDEN_BLENDING_KETTLE_4_ROW As Long = 119
Public Const gnBEV_HIDDEN_BLENDING_KETTLE_5_ROW As Long = 120
Public Const gnBEV_HIDDEN_STERILIZER_1_ROW As Long = 121
Public Const gnBEV_HIDDEN_STERILIZER_2_ROW As Long = 122
Public Const gnBEV_HIDDEN_STERILIZER_3_ROW As Long = 123
Public Const gnBEV_HIDDEN_STERILIZER_4_ROW As Long = 124
Public Const gnBEV_HIDDEN_STERILIZER_5_ROW As Long = 125
Public Const gnBEV_HIDDEN_STERILIZER_6_ROW As Long = 126
Public Const gnBEV_HIDDEN_FILLER_A_ROW As Long = 127
Public Const gnBEV_HIDDEN_FILLER_B_ROW As Long = 128
Public Const gnBEV_HIDDEN_FILLER_E_ROW As Long = 129
Public Const gnBEV_HIDDEN_FILLER_H_ROW As Long = 130
Public Const gnBEV_HIDDEN_FILLER_J_ROW As Long = 131
Public Const gnBEV_HIDDEN_FILLER_L_ROW As Long = 132
This is the code that is ran where I run the update at.
Public Function UpdateBeverageCartoon(ByVal vsDay As String) As Long
Dim sCartoonSheet As String
Set moBeverageDict = New Dictionary
Set moBKDict = New Dictionary
' name of the cartoon sheet
sCartoonSheet = vsDay & gsCARTOON_SHEET_NAME
gsCartoonSheet = sCartoonSheet
Call ClearBeverageCartoon(gsCartoonSheet, False)
Call LoadDataToDictionary(vsDay)
' sort data for blocks
Call SortDictionary(moBeverageDict)
' sort data for kettles and sterlizers
Call SortDictionary(moBKDict)
Call PlaceDataOnBeverageCartoon
Set moBeverageDict = Nothing
Set moBKDict = Nothing
Private Function LoadDataToDictionary(ByVal vsDay As String) As Long
Dim oBeverageData As New clsBeverageData
Dim nCurrentRow As Long
Dim sCode As String
Dim nCrew As Long
Dim sSize As String
With ThisWorkbook.Worksheets(vsDay)
nCurrentRow = gnSTARTING_ROW
' get the prodcut code
sCode = .Range(gsBEV_PRODUCT_CODE & nCurrentRow).Value
' set day
ThisWorkbook.Worksheets(gsCartoonSheet).Range(gsBEV_CARTOON_DAY).Value = _
Format(.Range(gsBEV_DATE_LOCATION).Value, "ddd")
' set date
ThisWorkbook.Worksheets(gsCartoonSheet).Range(gsBEV_CARTOON_DATE).Value = _
Format(.Range(gsBEV_DATE_LOCATION).Value, "mm/dd/yy")
' go through sheet while there are product codes
While sCode <> ""
Set oBeverageData = New clsBeverageData
' fill in class
oBeverageData.sCanCode = .Range(gsBEV_CAN_CODE &
nCurrentRow).Value
oBeverageData.sCaseCode = .Range(gsBEV_PRODUCT_CODE &
nCurrentRow).Value
oBeverageData.sDesc = .Range(gsBEV_PRODCUT_DESCRIPTION &
nCurrentRow).Value
oBeverageData.sFiller = .Range(gsBEV_FILLER & nCurrentRow).Value
oBeverageData.sBlender = .Range(gsBEV_BLENDER & nCurrentRow).Value
oBeverageData.sSterilizer = .Range(gsBEV_STERLIZER &
nCurrentRow).Value
oBeverageData.sCaseType = .Range(gsBEV_CASE_TYPE &
nCurrentRow).Value
oBeverageData.sCaseCount = .Range(gsBEV_CASE_COUNT &
nCurrentRow).Value
sSize = .Range(gsBEV_BOTTLE_SIZE & nCurrentRow).Value
If IsNumeric(sSize) Then
sSize = CStr(CInt(sSize))
If InStr(1, sSize, "oz") < 1 Then sSize = sSize & " oz"
End If
oBeverageData.sBottleSize = sSize
oBeverageData.sScheduleBatch = .Range(gsBEV_SCHEDULED_BATCH &
nCurrentRow).Value
oBeverageData.sLapCode = .Range(gsBEV_LAP_CODE &
nCurrentRow).Value
oBeverageData.sBarCode = .Range(gsBEV_BAR_CODE &
nCurrentRow).Value
oBeverageData.sStartTime = .Range(gsBEV_START_TIME &
nCurrentRow).Value
oBeverageData.sEndTime = .Range(gsBEV_END_TIME &
nCurrentRow).Value
oBeverageData.sFiberCode = .Range(gsBEV_FIBER_CODE &
nCurrentRow).Value
oBeverageData.sFiberCode2 = .Range(gsBEV_FIBER_CODE2 &
nCurrentRow).Value
oBeverageData.sCapCode = .Range(gsBEV_CAP_CODE &
nCurrentRow).Value
oBeverageData.sCapCodeDescription =
..Range(gsBEV_CAP_CODE_DESCRIPTION & nCurrentRow).Value
' check times
If ValidateTimes(oBeverageData.sStartTime,
oBeverageData.sEndTime, gsCartoonSheet, oBeverageData.sDesc) = SUCCESS Then
oBeverageData.sStartTime =
ConvertTimeToMiltary(oBeverageData.sStartTime)
oBeverageData.sEndTime =
ConvertTimeToMiltary(oBeverageData.sEndTime)
If Not IsNumeric(.Range(gsBEV_CREW & nCurrentRow).Value) Then
nCrew = gnCREW_NOT_ENTERED
Else
nCrew = .Range(gsBEV_CREW & nCurrentRow).Value
End If
oBeverageData.nCrew = nCrew
' add to dictionary that will place block data
Call AddClassToArrayInDictionary(moBeverageDict,
oBeverageData, oBeverageData.nCrew)
' add to dictionary that will place data to fill in cartoon
portion
Call AddClassToArrayInDictionary(moBKDict, oBeverageData,
oBeverageData.sSterilizer)
nCurrentRow = nCurrentRow + gnROW_INCREMENT
sCode = .Range(gsBEV_PRODUCT_CODE & nCurrentRow).Value
End If
Wend
End With
' XX DEBUG ONLY
'Call DumpDict(moBeverageDict)
Set oBeverageData = Nothing
End Function
Private Function SortDictionary(ByRef roDict As Dictionary) As Long
Dim vntItems As Variant
Dim vntKeys As Variant
Dim nI As Long
Dim nJ As Long
Dim nK As Long
Dim oCurrentBevData As clsBeverageData
Dim oTemBevData As clsBeverageData
Dim oaCurrentDictItem As Variant
vntItems = roDict.Items
vntKeys = roDict.Keys
' loop each itme
For nI = LBound(vntItems) To UBound(vntItems)
oaCurrentDictItem = vntItems(nI)
' lopp each array in dictionary
For nJ = LBound(oaCurrentDictItem) To UBound(oaCurrentDictItem) - 1
' compare loop
For nK = nJ + 1 To UBound(oaCurrentDictItem)
If nJ <> nK Then
' swap
If
oaCurrentDictItem(nJ).ISTimeLessThanMine(oaCurrentDictItem(nK).sStartTime) =
True Then
Set oTemBevData = oaCurrentDictItem(nJ)
Set oaCurrentDictItem(nJ) = oaCurrentDictItem(nK)
Set oaCurrentDictItem(nK) = oTemBevData
End If
End If
Next nK
Next nJ
roDict.Item(vntKeys(nI)) = oaCurrentDictItem
Next nI
'Call DumpDict(roDict)
End Function
Private Function PlaceDataOnBeverageCartoon()
Call PlaceBlockDataOnBeverageCartoon
Call PlaceKettleInfoOnBeverageCartoon
Call RemoveDuplicates
End Function
Private Function PlaceBlockDataOnBeverageCartoon()
Dim vntKeys As Variant
Dim vntItems As Variant
Dim nI As Long
Dim nJ As Long
Dim oaFiller As Variant
Dim oBevData As clsBeverageData
Dim nOffset As Long
Dim sColumn As String
Dim nItemsPlacedForFiller As String
Set moCrewDict = New Dictionary
vntKeys = moBeverageDict.Keys
vntItems = moBeverageDict.Items
' loop dictioanry
For nI = LBound(vntItems) To UBound(vntItems)
oaFiller = vntItems(nI)
nItemsPlacedForFiller = 0
' loop array in dictionary, this is each row of data for a filler
For nJ = LBound(oaFiller) To UBound(oaFiller)
Set oBevData = oaFiller(nJ)
If oBevData.nCrew <> gnCREW_NOT_ENTERED Then
' column to place data in
sColumn = GetBlockColumnForFiller(oBevData.sFiller)
' determines row to write data to
nOffset = GetRowOffsetForFillerData(oBevData)
' for valid column and row, write the data
If sColumn <> "" And _
nOffset <> gnOFFSET_NOT_FOUND And _
nOffset < gnBEV_DATA_BLOCK_MAX Then
With ThisWorkbook.Sheets(gsCartoonSheet)
Select Case UCase(oBevData.sFiller)
Case "J"
.Range(gsBEV_J_BOTTLE_SIZE &
gnBEV_BOTTLE_SIZE).Value = oBevData.sBottleSize
Case "L"
.Range(gsBEV_L_BOTTLE_SIZE &
gnBEV_BOTTLE_SIZE).Value = oBevData.sBottleSize
End Select
.Range(sColumn & gnBEV_START_TIME + nOffset *
gnBEV_DATA_BLOCK_ROW_INCREMENT).Value = oBevData.sStartTime
.Range(sColumn & gnBEV_CASE_CODE + nOffset *
gnBEV_DATA_BLOCK_ROW_INCREMENT).Value = oBevData.sCaseCode
.Range(sColumn & gnBEV_LAP_CODE + nOffset *
gnBEV_DATA_BLOCK_ROW_INCREMENT).Value = oBevData.sLapCode
.Range(sColumn & gnBEV_BAR_CODE + nOffset *
gnBEV_DATA_BLOCK_ROW_INCREMENT).Value = oBevData.sBarCode
.Range(sColumn & gnBEV_CASE_TYPE + nOffset *
gnBEV_DATA_BLOCK_ROW_INCREMENT).Value = oBevData.sCaseType
.Range(sColumn & gnBEV_CASE_COUNT + nOffset *
gnBEV_DATA_BLOCK_ROW_INCREMENT).Value = oBevData.sCaseCount
.Range(sColumn & gnBEV_SCHEDULED_BATCH + nOffset *
gnBEV_DATA_BLOCK_ROW_INCREMENT).Value = oBevData.sScheduleBatch
.Range(sColumn & gnBEV_STOP_TIME + nOffset *
gnBEV_DATA_BLOCK_ROW_INCREMENT).Value = oBevData.sEndTime
End With
' fills in description for filler
Call PlaceHiddenData(GetFillerRow(oBevData.sFiller),
Left(oBevData.sDesc, gsBEV_DESC_LENGTH))
nItemsPlacedForFiller = nItemsPlacedForFiller + 1
End If
End If
Next nJ
Next nI
Set moCrewDict = Nothing
End Function
Private Function PlaceKettleInfoOnBeverageCartoon()
Dim vntKeys As Variant
Dim vntItems As Variant
Dim nI As Long
Dim nJ As Long
Dim nK As Long
Dim oaBK As Variant
Dim oBevData As clsBeverageData
Dim nItemsPlaced As Long
Dim nRow As Long
Dim sColumn As String
Dim sPreviousFiller As String
Dim bDashedLine As Boolean
Dim nSecondRow As Long
vntKeys = moBKDict.Keys
vntItems = moBKDict.Items
' loop dictionary
For nI = LBound(vntItems) To UBound(vntItems)
oaBK = vntItems(nI)
sPreviousFiller = ""
bDashedLine = False
nItemsPlaced = 0
' loop array in dictioanry
For nJ = LBound(oaBK) To UBound(oaBK)
' only can have 5 items for each blending kettle
If nItemsPlaced = 6 Then Exit For
Set oBevData = oaBK(nJ)
If oBevData.nCrew <> gnCREW_NOT_ENTERED Then
' fill in sterlizer info
nRow = GetSterilzerRow(oBevData.sBlender, nSecondRow)
If nRow <> gnROW_NOT_FOUND Then
Call PlaceHiddenData(nRow, Left(oBevData.sDesc,
gsBEV_DESC_LENGTH))
If nSecondRow <> gnROW_NOT_FOUND Then Call
PlaceHiddenData(nSecondRow, Left(oBevData.sDesc, gsBEV_DESC_LENGTH))
End If
' fill in blender info, goes to bk, supply tanks
nRow = GetKettleRow(oBevData.sBlender, nSecondRow)
If nRow <> gnROW_NOT_FOUND Then
Call PlaceHiddenData(nRow, oBevData.sCanCode)
If nSecondRow <> gnROW_NOT_FOUND Then Call
PlaceHiddenData(nSecondRow, oBevData.sCanCode)
End If
' determines if line from filler supply tank to filler
should be dashed
' rule is second product type for that day is dashed
If sPreviousFiller <> oBevData.sFiller And sPreviousFiller
<> "" Then
bDashedLine = True
End If
' puts in the line
Call
DrawBevCartoonLine(GetFillerTankFromKettle(oBevData.sBlender),
oBevData.sFiller, bDashedLine)
sPreviousFiller = oBevData.sFiller
nItemsPlaced = nItemsPlaced + 1
End If
Next nJ
Next nI
End Function
Private Function RemoveDuplicates()
Dim nI As Long
Dim nJ As Long
Dim sColumn As String
Dim sPreviouColumn As String
Dim sCurrent As String
Dim sPrevious As String
Dim nOffset As Long
Dim nK As Long
Dim nNextColumn As String
' loop each row of temp table
For nI = gnBEV_TEMP_CARTOON_VALUES_ROW_START To
gnBEV_TEMP_CARTOON_VALUES_ROW_END
' loop from item 2 to max
For nJ = gnBEV_FILLER_COUNTERPARTS To 2 Step -1
nOffset = nJ - gnBEV_FILLER_COUNTERPARTS
sColumn = GenerateColumnForData(nOffset,
gsBEV_TEMP_CARTOON_VALUES_COLUMN_END)
sPreviouColumn = GenerateColumnForData(nOffset - 1,
gsBEV_TEMP_CARTOON_VALUES_COLUMN_END)
' get values
sCurrent = ThisWorkbook.Sheets(gsCartoonSheet).Range(sColumn &
nI).Value
sPrevious =
ThisWorkbook.Sheets(gsCartoonSheet).Range(sPreviouColumn & nI).Value
' if a match then remove
If sCurrent = sPrevious Then
ThisWorkbook.Sheets(gsCartoonSheet).Range(sColumn &
nI).Value = ""
For nK = nJ To gnBEV_FILLER_COUNTERPARTS
nOffset = nK - gnBEV_FILLER_COUNTERPARTS
sColumn = GenerateColumnForData(nOffset,
gsBEV_TEMP_CARTOON_VALUES_COLUMN_END)
If sColumn = gsBEV_TEMP_CARTOON_VALUES_COLUMN_END Then
ThisWorkbook.Sheets(gsCartoonSheet).Range(sColumn &
nI).Value = ""
Else
nNextColumn = GenerateColumnForData(nOffset + 1,
gsBEV_TEMP_CARTOON_VALUES_COLUMN_END)
ThisWorkbook.Sheets(gsCartoonSheet).Range(sColumn &
nI).Value = ThisWorkbook.Sheets(gsCartoonSheet).Range(nNextColumn & nI).Value
End If
Next nK
End If
Next nJ
Next nI
End Function
The original program only had 4 Sterilizers and I had to add two more. I
know that this is a lot of code and it will probably be a little difficult to
go through. Any help would be greatly appreciated.
