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.
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