How to edit this copy and paste VBA code to include duplicate values?

Indominus

Board Regular
Joined
Jul 11, 2020
Messages
117
Office Version
  1. 2016
Platform
  1. Windows
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.

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
 

Attachments

  • Auto Pickorder image.JPG
    Auto Pickorder image.JPG
    168.2 KB · Views: 12
  • PasteWavePlan image.JPG
    PasteWavePlan image.JPG
    186.6 KB · Views: 11
  • Final Auto Pickorder image.JPG
    Final Auto Pickorder image.JPG
    214.6 KB · Views: 12

Indominus

Board Regular
Joined
Jul 11, 2020
Messages
117
Office Version
  1. 2016
Platform
  1. Windows
I've had a look at the code and it's identical to mine, so the next step is look at the spreadsheets themselves. You will need to have installed the XL2BB Excel add-on to do this. If you haven't it is available here XL2BB Select all the cells that have values in Sheet(1) on the Pick Order workbook, run the XL2BB add-in (select all the options) and then paste it here. Do the same for the C1 Wave Plan sheet. I'll then have a look to see if there any differences between your spreadsheets and the ones I constructed.

I have assumed from reading your code that Sheet(1) and C1 Wave Plan are in different workbooks.
Hi, so I tried to use the add-on however, it would not work for me. So I uploaded both workbooks into Dropbox. Hope it is okay. The macro for the copy and paste code is titled "Copyandpastewaveplancycle1." It is the code in your first post. Thank you once again! Here is the link Pickorder
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

ExcelGzh

Board Regular
Joined
Mar 29, 2020
Messages
130
Office Version
  1. 365
Platform
  1. Windows
Indominus

The problem is that the spreadsheet MCO Routing Macro has still got the first version of the code that I posted on 7 December. You need to use the code that I posted on 12 December. It's the one that has this line of code that looks for cells in Column A:

For Each cell In bk.Sheets(1).Range("A2:A" & bk.Sheets(1).Range("A1048576").End(xlUp).Row)

In the previous version of the code this line looked for cells in Column B:

For Each cell In bk.Sheets(1).Range("B2:B" & bk.Sheets(1).Range("B1048576").End(xlUp).Row)

When I copied the second version of the code into MCO Routing Macro as far as I could tell it worked fine.
 

Indominus

Board Regular
Joined
Jul 11, 2020
Messages
117
Office Version
  1. 2016
Platform
  1. Windows
Indominus

The problem is that the spreadsheet MCO Routing Macro has still got the first version of the code that I posted on 7 December. You need to use the code that I posted on 12 December. It's the one that has this line of code that looks for cells in Column A:

For Each cell In bk.Sheets(1).Range("A2:A" & bk.Sheets(1).Range("A1048576").End(xlUp).Row)

In the previous version of the code this line looked for cells in Column B:

For Each cell In bk.Sheets(1).Range("B2:B" & bk.Sheets(1).Range("B1048576").End(xlUp).Row)

When I copied the second version of the code into MCO Routing Macro as far as I could tell it worked fine.
Hi. Sorry if if my post was not clear. My bad. The workbook is saved with the old code since that first code worked somewhat. I had pasted your new code twice over it before and tried it. And it didn’t work. It pasted it into the staging location cells still. I just didn’t save the Routing Macro workbook after. Will try again later when I get home.
 

Indominus

Board Regular
Joined
Jul 11, 2020
Messages
117
Office Version
  1. 2016
Platform
  1. Windows
Hi. Sorry if if my post was not clear. My bad. The workbook is saved with the old code since that first code worked somewhat. I had pasted your new code twice over it before and tried it. And it didn’t work. It pasted it into the staging location cells still. I just didn’t save the Routing Macro workbook after. Will try again later when I get home.
Hello! So great news. I just tried it again and it worked. My problem was I was using a Pickorder file unedited from the very beginning. Long story, at first they do not originally have the DSP's. I have a code to add them. Thank you so much it works perfectly. I have tried to get some help with this for awhile now with no luck until you. It is very much appreciated you have no idea!!!
 

ExcelGzh

Board Regular
Joined
Mar 29, 2020
Messages
130
Office Version
  1. 365
Platform
  1. Windows
Glad to be of assistance. Good luck with the project.
 

Watch MrExcel Video

Forum statistics

Threads
1,133,828
Messages
5,661,170
Members
418,619
Latest member
ibruzzi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top