Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Excel / Setup / August 2006

Tip: Looking for answers? Try searching our database.

Update a list

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
Mindie - 09 Aug 2006 23:16 GMT
I have an excel program where the user goes and inputs data using a list that
I have defined in AT3 through AY3.  I then have the user run an update
function that will produce all of the data onto another spreadsheet.  
Originally I had only AT3 through AW3 and I added AX3 and AY3.  When I run
the update, I cannot get the AY3 to appear on the other page.  I am not an
expert with VBA but I have tried to update the existing code and I am having
no luck.  When you use the drop down list to add the fields, it updates the
2nd page with the information.  B121 - B126.  Unfortunately it will update
the first 3 correctly, but will move AY3 into B125, and AX3 into B124.  It is
suppose to move AY3 to B126, AX3 into B125 and so on.  I hope that I haven't
confused you and I really don't know how to explain this any further.  Is
there a way to look at the counter or see if there is a counter in the VBA
code that I need to update say from 5 to 6?   All of my data for 6 is going
into 5 and all of my data for 5 is going into 4 and 4 should be blank.  Help
me if you can.
Pete_UK - 10 Aug 2006 11:40 GMT
You will need to post your code if you hope to get any help on this.

Pete

> I have an excel program where the user goes and inputs data using a list that
> I have defined in AT3 through AY3.  I then have the user run an update
[quoted text clipped - 11 lines]
> into 5 and all of my data for 5 is going into 4 and 4 should be blank.  Help
> me if you can.
Mindie - 10 Aug 2006 14:10 GMT
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.

> You will need to post your code if you hope to get any help on this.
>
[quoted text clipped - 15 lines]
> > into 5 and all of my data for 5 is going into 4 and 4 should be blank.  Help
> > me if you can.
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.