Hello. So I have two workbooks here. I have attached screenshots of both. One is Pickorder. Column A lists the dispatch times. Column B has route codes. Column D has the dispatch areas. Column E has the dsp taking the route. For example, CX19 dispatches at 6:15:00, at STG.A01 for HIQL. I then have this Wave planner sheet. This VBA code copies and pastes the route codes (column B) into the correct time column on the Wave Planner matching the staging location and dsp. However, the Pickorder I receive daily has duplicate staging locations at different times. For example route codes that dispatch at 8:15:00 have dispatch area A also and start at STG.A01. Whenever I run the macro it gives me error code '457', "this key is already associated with an element of this collection."
This code works perfectly if there are no duplicate dispatch zones. Attached is an image of how the wave planner should look like after the route codes are copied and pasted in this example. How would I edit this code to match the criteria's of the dispatch time along with the staging area and dsp? Thank you to anyone willing to help me. Here is the full code I have now.
This code works perfectly if there are no duplicate dispatch zones. Attached is an image of how the wave planner should look like after the route codes are copied and pasted in this example. How would I edit this code to match the criteria's of the dispatch time along with the staging area and dsp? Thank you to anyone willing to help me. Here is the full code I have now.
VBA Code:
Sub CopyPasteDuplicates()
Dim bk As Workbook, Sht As Worksheet
Dim dict As Object, ky As Variant
Dim cell As Range, f As Range, c As Range
For Each bk In Application.Workbooks
If UCase(bk.Name) Like UCase("*Pick*order*") Then Exit For
Next bk
If bk Is Nothing Then
MsgBox "Workbook not found", vbCritical
Exit Sub
End If
Set dict = CreateObject("scripting.dictionary")
For Each cell In bk.Sheets(1).Range("B2:B" & bk.Sheets(1).Range("B1048576").End(xlUp).Row)
If dict.Exists(Trim$(cell.Offset(0, 2).Value2)) Then
MsgBox "Duplicate staging areas detected. Identify duplicate staging area in Column D of Pickorder and insert unique staging area. Input linked route code into Wave Plan"
Else
dict.Add Trim$(cell.Offset(0, 2).Value2), Array(abbrev_dsp(cell.Offset(0, 3).Value2), cell.Value2)
End If
Next cell
If dict.Count = 0 Then
MsgBox "Data not found", vbCritical
Exit Sub
End If
Set Sht = ThisWorkbook.Sheets("C1 Wave Plan")
For Each ky In dict.keys
Set f = Sht.Cells.Find(ky, , xlValues, xlWhole, , , False)
If Not f Is Nothing Then
If dict(Trim$(ky))(0) = "" Then
f.Offset(0, 1).Value = dict(Trim$(ky))(1)
Else
Set c = Sht.Range(Sht.Cells(3, f.Column), Sht.Cells(3, f.Column + 6)).Find(dict(Trim$(ky))(0), , xlValues, xlWhole, , , False)
If Not c Is Nothing Then
Sht.Cells(f.Row, c.Column).Value = dict(Trim$(ky))(1)
End If
End If
End If
Next ky
End Sub
'********
Function abbrev_dsp(dspCode As String) As String
Select Case Trim$(dspCode)
Case "AROW"
dspCode = "AW"
Case "JPDG"
dspCode = "JP"
Case "HIQL"
dspCode = "HQ"
End Select
abbrev_dsp = Trim$(dspCode)
End Function
