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

Indominus

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

VBA Code:
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
 

Attachments

  • po(example).JPG
    po(example).JPG
    23.5 KB · Views: 9
  • waveplanner example.JPG
    waveplanner example.JPG
    23.3 KB · Views: 9

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,582
Office Version
  1. 2007
Platform
  1. Windows
How about:

VBA Code:
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
 
Solution

Indominus

Board Regular
Joined
Jul 11, 2020
Messages
126
Office Version
  1. 2016
Platform
  1. Windows
How about:

VBA Code:
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

Well-known Member
Joined
Dec 3, 2018
Messages
13,582
Office Version
  1. 2007
Platform
  1. Windows
Im glad to help you, thanks for the feedback.
 

Forum statistics

Threads
1,141,281
Messages
5,705,474
Members
421,397
Latest member
JBenn911

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