Code To Look For Number On Sheet 1 And Put Another Number Directly Below

[Dazzawm]

I have sheet 2 with a list of numbers in column A. I need a code please that will look for these numbers on sheet 1 in column AD and put the number that is next to it in column B on sheet 2 in the cell directly below in column Ad on sheet 1. Thanks.

Excel 2010
	A	B
1
2	Test	Test1
3	Data	Data1
Sheet2

Sheet 1 Before

Excel 2010
	AD
2	Test
3	NYA
4	NYA
5	Test
6	NLA
7	Data
8	NYA
9	NYA
10	NYA
11	NYA
12	Data
Sheet1

Sheet 1 After. I have highlighted the cells where the data has been added.

Excel 2010
	AD
2	Test
3	Test1
4	NYA
5	Test
6	Test1
7	Data
8	Data1
9	NYA
10	NYA
11	NYA
12	Data
13	Data1
Sheet1

Thanks.

 

[Dazzawm]

Hi Worf, what part do I need to change so it does the cells directly above rather than below as it does now? Thanks.

 

[Dazzawm]

Had chance to look at this yet Worf? I've tried changing some offsets but it doesn't work.

 

[Worf]

New version:

Sub MG13Oct00_Worf()
Dim Rng1 As Range, Dn As Range, Rng2 As Range, sm As Worksheet
With Sheets("Sheet2")
    Set Rng2 = .Range(.[a1], .Range("A" & Rows.Count).End(xlUp))
End With
With Sheets("Sheet1")
    Set Rng1 = .Range(.[AD1], .Range("AD" & Rows.Count).End(xlUp))
End With
If Not SheetExists("summary") Then
    Sheets.Add , Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "Summary"
End If
Set sm = Sheets("summary")
sm.[a:a].ClearContents
sm.[a1] = "Addresses are listed below:"
With CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
    For Each Dn In Rng2
       Set .Item(Dn.Value) = Dn
    Next
    Sheets("sheet2").Activate
    For Each Dn In Rng1             'column AD
        If .Exists(Dn.Value) Then
            If Dn.Offset(-1) = "NLA" Or Dn.Offset(-1) = "NYA" Or Dn.Offset(-1) = "N/A" Then
                Dn.Offset(-1) = .Item(Dn.Value).Offset(, 1)     ' negative offset is the row above
                Dn.Offset(-1, 1) = .Item(Dn.Value).Offset(, 2)  ' offset(row,column)
            Else
                sm.Cells(sm.Range("a" & Rows.Count).End(xlUp).Row + 1, 1) = Dn.Offset(-1).Address
                Dn.Offset(-1).Interior.Color = RGB(170, 120, 160)
            End If
        End If
    Next
End With
End Sub

 

[Dazzawm]

Thanks worf I will try at work in the morning.

 

[Dazzawm]

Try this:-

[COLOR=Navy]Sub[/COLOR] MG13Oct00
[COLOR=Navy]Dim[/COLOR] Rng1 [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, Rng2 [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]With[/COLOR] Sheets("Sheet2")
    [COLOR=Navy]Set[/COLOR] Rng2 = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]With[/COLOR] Sheets("Sheet1")
    [COLOR=Navy]Set[/COLOR] Rng1 = .Range(.Range("AD1"), .Range("AD" & Rows.Count).End(xlUp))
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng2
   [COLOR=Navy]Set[/COLOR] .Item(Dn.Value) = Dn
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng1
    [COLOR=Navy]If[/COLOR] .Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
        Dn.Offset(1).Value = .Item(Dn.Value).Offset(, 1).Value
        Dn.Offset(1, 1).Value = .Item(Dn.Value).Offset(, 2).Value
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

Sorry its been a while since you did this code Mick. You can probably tell what it does by looking at it but if possible I would like a line of code added so that when a value is added below it colours the rows? Thanks

 

[MickG]

Possibly, untested:-

For Each Dn In Rng1
    If .Exists(Dn.Value) Then
        Dn.Offset(1).Value = .Item(Dn.Value).Offset(, 1).Value
        
       [COLOR="#FF0000"][B]Dn.offset(1).Entirerow.interior.color = vbyellow
[/B][/COLOR]        
       Dn.Offset(1, 1).Value = .Item(Dn.Value).Offset(, 2).Value
    End If
Next Dn

 

[Dazzawm]

Thanks but it coloured the entire sheet?

 

[MickG]

When I run the code on your data in Post#1 it returns the same results as shown in post#1 except the whole row is highlighted.
What part of that doesn't work for you.???

 

[Dazzawm]

Sorry I got confused on code. You did 2 for me in this thread the one I need is the code in post 3 where it does not add description like the other.

 

[MickG]

Ref:- Post#3 Code
Modify Post#3 code with lines in red below:-

For Each Dn In Rng1
   
  [COLOR="#FF0000"][B] If .Exists(Dn.Value) Then
        Dn.Offset(1) = .Item(Dn.Value)
        Dn.Offset(1).EntireRow.Interior.Color = vbYellow
   End If
[/B][/COLOR]
Next Dn