Re: VBA to match value in one column to another and paste adjacent value
Each day I begin by pasting two columns of data in columns O and B. I'm just trying to get the data in column O over to column G by matching the station call letters. I realize that if one station has two entries in column O on a particular day, that only one of them with go into column G. I will have to later edit the cell in col G to add the amount that did not go when the macro ran.
You gave me this code a couple of months ago that compares stations and amounts to a list of station and amounts, then copies any amounts that match both criteria to specific column/row. What I hoped for this time was to just compare col O to col B and when they match, copy the adjacent value from column P to column G. Perhaps it would just be a case of modifying this code?
Option Explicit
Sub Treat()
Dim ObjDic As Object
Set ObjDic = CreateObject("Scripting.Dictionary")
Dim LR As Long
Dim I As Long
Dim WkDate As Date
Const FR As Integer = 7 ' First Row of data
Dim Temp
Application.ScreenUpdating = False
WkDate = Range("I1")
With ObjDic
LR = Range("M" & Rows.Count).End(3).Row
For I = FR To LR
If (Cells(I, "N") <> "") Then .Item(Cells(I, "M").Value & "/" & Cells(I, "N").Value) = Cells(I, "N").Value
Next
LR = Range("A" & Rows.Count).End(3).Row
For I = FR To LR
If (Cells(I, "B") <> "") Then
Temp = Cells(I, "A").Value & "/" & Cells(I, "B").Value
If (.exists(Temp)) Then
Cells(I, "C") = Format$(WkDate, "mm/dd/yy")
Cells(I, "D") = Cells(I, "B")
.Item(Temp) = ""
End If
End If
Next I
LR = Range("M" & Rows.Count).End(3).Row
For I = FR To LR
If (Cells(I, "N") <> "") Then
Temp = Cells(I, "M").Value & "/" & Cells(I, "N").Value
If (.exists(Temp)) Then Cells(I, "N") = ""
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Display More
