VBA help needed ~ lookup/insert

[unit213]

Hey guys...

I need some VBA help. I'm not sure how difficult this will be, but it's way out of my league for now unfortunately.

Here's a sample spreadsheet:

Index Match Example.xls
	A	B	C	D
1	Shoe	Shoe	Color
2	Nike	Nike	White
3	Reebok	Reebok	Gray
4	NewBalance	NewBalance	Blue
5		Nike	Blue
6		Reebok	Red
7		Reebok	Green
8		NewBalance	White
Sheet1

Here's the challenge:

Lookup the values in column A. Locate them in colum B. Find the corresponding value in column C. Take the value found in column C and insert it below the correct value in column A.

Example of completed spreadsheet:

Index Match Example.xls
	A	B	C	D
12	Shoe
13	Nike
14	White
15	Blue
16	Reebok
17	Gray
18	Red
19	Green
20	NewBalance
21	Blue
22	White
Sheet1

Can anyone offer up some help? Much appreciated as always. Thanks.

Dan

 

[NdNoviceHlp]

If I understand what you're after, this code seems to work. Dave

Private Sub CommandButton1_Click()
Dim Rng As Range, Rng2 As Range, rng3 As Range
Dim i As Integer, Cnt As Integer, Counter As Integer
'row1 is title
'Matches "A" with "B". Enters match name "B" only once...
'2 rows below last "A" then adds "C" values of A/B match
'to next "A" row
Set Rng2 = Range("a2:a" & Range("a2").End(xlDown).Row)
Set Rng = Range("B2:B" & Range("B2").End(xlDown).Row)
'use to clear "A" of previous results
Range("a65536:a" & Range("a2").End(xlDown).Row + 1).ClearContents
Counter = 1
For Cnt = 2 To Rng2.Rows.Count + 1
off = 0
For i = 2 To Rng.Rows.Count + 1
If Cells(Cnt, 1) = Cells(i, 2) Then
If off = 0 Then
Counter = Counter + 1
Cells(Rng2.Rows.Count + 1 + Counter, 1) = Cells(i, 2)
off = 1
End If
Counter = Counter + 1
Cells(Rng2.Rows.Count + 1 + Counter, 1) = Cells(i, 3)
End If
Next i
Next Cnt
End Sub