Look up - HELP!!!

[James8309]

Hi everyone,

I am having alot of trouble doing simple look up due to my limited
knowledge in VBA.

I have list of codes in column B:B and code consist of letter &
numbers.
i.e. A123, B111 so on...

I just want to find a particular code that I want and return 3
prevoius codes and 2 codes after.
i.e.

if code that I want to search is "B111" and if range(B1:Bn) are as
follows;

B
1 A123
2 D892
3 Z2812
4 B111
5 E918
6 U192
7 ....

I want to return A123, D892 and Z2812 = 3 previous codes & E918 and
U192 = 2 codes after the look up value in columns. If there are
multiple look up value in the column, How do I make it look for the
next "B111" in this case then perform the same step?
i.e. if "B111" is found in B100 ( get B99,B98,B97 and B101,B102) and
return it in columns (Starting from column D, to X number of columns)
if there are 10 "B111", then first result will be in column D, second
finding will be in column E and so on.


I tried autofiltering, I tried using offset I tried everything but I
just can't get the end result that I wanted.

if anyone can help, that would be much appreciated.

 

[Don Guillett]

You can use a FINDNEXT macro to do this. I'm not quite sure what about
desired your final result. Send a workbook to my address below with
before/after examples.

 

[Don Guillett]

I sent this
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Intersect(Target, Range("c2")) Is Nothing Then Exit Sub
'luv = Target
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(2, Columns.Count).End(xlToLeft).Column + 1
Range(Cells(2, "d"), Cells(2, lc)).EntireColumn.Delete
With Range("b1:b" & lr)

Set c = .Find(Target, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do

lc = Cells(2, Columns.Count).End(xlToLeft).Column + 1
'MsgBox c.Row
Cells(c.Row, "a").Copy Cells(1, lc)
Cells(c.Row, "b").Offset(-2).Resize(5).Copy Cells(2, lc)
Cells(4, lc).Font.ColorIndex = 3
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If

End With
Columns.AutoFit
ActiveSheet.PageSetup.PrintArea = Range(Cells(1, "d"), Cells(6, lc)).Address
Application.ScreenUpdating = True
End Sub