How to edit this copy and paste VBA code to not use a criteria if not found?

[Indominus]

Hello. I have this copy and paste code that copies cell values from one workbook to another. Copy from pickorder. Paste into wave planner. To match it up it gets the staging location in column D example, "STG.DD35" and the dsp in column E "M5DV." However sometimes this first sheet, referenced as pickorder does not have a dsp in column E. How can I edit this code to match up the staging location and dsp, but if there is no dsp in column E then just use the staging location? Here are two screenshots of what it is doing to a route code when there is no dsp value. And the code. You can see CX138 is not pasted in the correct area. Thank you!

Dim bk As Workbook
    Dim dict As Object
    Dim cell As Range
    Dim Sht As Worksheet

    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)
        dict.Add Trim$(cell.Offset(0, 2).Value2), Array(abbrev_dsp(cell.Offset(0, 3).Value2), cell.Value2)
    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 cell In Sht.UsedRange
        If cell.Value2 <> vbNullString And dict.exists(Trim$(cell.Value2)) Then
            For i = 1 To 5
                With cell.Offset(0, i)
                    If Trim$(Sht.Cells(3, .Column).Value2) = dict(Trim$(cell.Value2))(0) Then
                        .Value2 = dict(Trim$(cell.Value2))(1)
                        Exit For
                    End If
                End With
            Next i
        End If
    Next cell

    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

 

[DanteAmor]

How about:

Sub copy_paste_1()
  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)
    dict.Add Trim$(cell.Offset(0, 2).Value2), Array(abbrev_dsp(cell.Offset(0, 3).Value2), cell.Value2)
  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

 

[Indominus]

How about:

Sub copy_paste_1()
  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)
    dict.Add Trim$(cell.Offset(0, 2).Value2), Array(abbrev_dsp(cell.Offset(0, 3).Value2), cell.Value2)
  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

Works perfectly! Thank you so much.

 

[DanteAmor]

Im glad to help you, thanks for the feedback.