Transfer array element offset value to a matched value

  • Thread starter Thread starter L. Howard
  • Start date Start date
L

L. Howard

Columns A,B (C IS BLANK) D,E


10000001 23 10000027 001
10000002 2 10000037 013
10000003 11 10000008 028
10000004 11 10000059 011
10000005 11 10000065 001
10000006 1 10000066 011
10000007 92 10000070 001
10000008 99 10000137 001
10000009 0 10000138 001

If a value in column D is found in column A, then replace the value in column B with the value in column E.

The only match in example is 1000008, so the 99 in column B would be replaced with the value 028 from column E.

And column C would be noted with **X**.

Column A/B about 11,000 rows, column D/E about 700 rows.

Thanks,
Howard

The commented out code lines do not work for me.

Sub A_D_Var_Range()

Dim lr As Long, i As Long
Dim c As Range, aChng As Range
Dim dArray As Variant
Dim vArr As Range


With Sheets("Sheet1")
lr = .Cells(Rows.Count, "D").End(xlUp).Row
dArray = .Range("D2:D" & lr)


For i = 2 To UBound(dArray)

' Set vArr = dArray(i, 1).Offset(, 1)

Set aChng = Sheets("Sheet1").Range("A:A").Find(What:=dArray(i, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not aChng Is Nothing Then

'***
'aChng.Offset(, 1) = dArray(i, 1).Offset(, 1).Value
'aChng.Offset(, 1) = vArr
'***

aChng.Offset(, 2) = "**X**"
Else
MsgBox "No match found. "
End If

Next 'i
End With

End Sub
 
Try...

Sub XferMatches()
Dim n&, j&, r1&, r2&, vData, vTmp

r1 = Cells(Rows.Count, 1).End(xlUp).Row
r2 = Cells(Rows.Count, 4).End(xlUp).Row

vData = Range("A2:E" & r1): vTmp = Range("D2:E" & r2)
For j = LBound(vData) To UBound(vData)
For n = LBound(vTmp) To UBound(vTmp)
If vTmp(n, 1) = vData(j, 1) Then
vData(j, 2) = vTmp(n, 2): vData(j, 3) = "**X**"
End If
Next 'n
Next 'j

Range("A2").Resize(UBound(vData), UBound(vData, 2)) = vData
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Back
Top