How to edit this copy and paste VBA code to include column offset value?

Indominus

Board Regular
Joined
Jul 11, 2020
Messages
160
Office Version
  1. 2016
Platform
  1. Windows
Hi. I have this code that copied and pastes data from two different workbooks based on matching data. However, I also need to include the value in the fourth column over.

So for example the last line should be something like. But I am getting an error on this line.

Sht.Cells(f.Row, C.Column).Value = dict(Trim$(ky))(1) & cell.Offset(0,4)

Here is the full code.

VBA Code:
Dim bk As Workbook, Sht As Worksheet

Dim dict As Object, ky As Variant

Dim cell As Range, f As Range, C As Range



Dim routeSize As String





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 "Error"

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("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
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

Forum statistics

Threads
1,223,099
Messages
6,170,111
Members
452,302
Latest member
TaMere

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
Back
Top