Multiple vlookup and a little extra.
 

I need VB code to do the following. Take active cell from sheet A and look
for it on sheet B. If found return a value if not found return, "not found"
and then add a row under the row it returned a value to. It would continue to
look for the active cell from sheet A and repeat the above until it got to
the bottom of sheet B. It would then go down an active cell on sheet A and
skip the lookup it the active cell is empty until it found an active cell on
sheet A that was not and then it would do it all over again for say a counter
of 100...

first active cell = Part A from sheet A


Sheet B Value to Return
Part G 1-Jul-07
Part A 2-Aug-07
Part E 30-Dec-06
Part A 25-Jul-07
Part F 15-Oct-06

before Sheet A Value returned here
Part A
Part B
Part C
Part D
Part E

Sheet A Value returned here
after Part A 2-Aug-07
25-Jul-07
Part B not found
Part C not found
Part D not found
Part E 30-Dec-06

--
Regards,
Michael

Multiple vlookup and a little extra.
 

Sub FindDates()
Dim rngA As Range, shA As Worksheet
Dim rngB As Range, shB As Worksheet
Dim rng As Range, v, v1
Dim i As Long, j As Long, j1 As Long
Dim s, sAddr As String
Set rngA = ActiveCell
Set shA = rngA.Parent
Set shB = Worksheets("SheetB")
Set rngB = shB.Range(shB.Range("A1"), _
shB.Range("A1").End(xlDown))
Set rngA = shA.Range(rngA, rngA.End(xlDown))
v = rngA.Value
j = 0
ReDim v1(1 To rngB.Count + rngA.Count, 1 To 2)
For i = LBound(v, 1) To UBound(v, 1)
s = v(i, 1)
Set rng = rngB.Find(What:=s, _
After:=rngB(rngB.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
j1 = 0
If Not rng Is Nothing Then
sAddr = rng.Address
Do
j = j + 1
j1 = j1 + 1
If j1 = 1 Then _
v1(j, 1) = v(i, 1)
v1(j, 2) = rng.Offset(0, 1).Text
Set rng = rngB.FindNext(rng)
Loop Until rng.Address = sAddr
Else
j = j + 1
v1(j, 1) = v(i, 1)
v1(j, 2) = "Not Found"
End If
Next i
rngA.Resize(UBound(v1), 2).Value = v1
End Sub

worked for me. It assumes that on SheetB that the data starts in A1.
Adjust to fit your situation. The ActiveCell when you run the macro should
be the cell containing PartA on sheetA.

--
Regards,
Tom Ogilvy

"Michael from Austin" wrote:

I need VB code to do the following. Take active cell from sheet A and look
for it on sheet B. If found return a value if not found return, "not found"
and then add a row under the row it returned a value to. It would continue to
look for the active cell from sheet A and repeat the above until it got to
the bottom of sheet B. It would then go down an active cell on sheet A and
skip the lookup it the active cell is empty until it found an active cell on
sheet A that was not and then it would do it all over again for say a counter
of 100...

first active cell = Part A from sheet A


Sheet B Value to Return
Part G 1-Jul-07
Part A 2-Aug-07
Part E 30-Dec-06
Part A 25-Jul-07
Part F 15-Oct-06

before Sheet A Value returned here
Part A
Part B
Part C
Part D
Part E

Sheet A Value returned here
after Part A 2-Aug-07
25-Jul-07
Part B not found
Part C not found
Part D not found
Part E 30-Dec-06

--
Regards,
Michael

Multiple vlookup and a little extra.
 

Wow, you lost me.... Your level of programing is way above mine.. where do I
put worksheet A's name B's name.. Where do I put in the first active cell on
sheet A? Where is it going to return the date? where do I put the column
value from sheet B i want returned? Sorry..., If you could help with this too
I would appreciate it...
--
Regards,
Michael


"Tom Ogilvy" wrote:

Sub FindDates()
Dim rngA As Range, shA As Worksheet
Dim rngB As Range, shB As Worksheet
Dim rng As Range, v, v1
Dim i As Long, j As Long, j1 As Long
Dim s, sAddr As String
Set rngA = ActiveCell
Set shA = rngA.Parent
Set shB = Worksheets("SheetB")
Set rngB = shB.Range(shB.Range("A1"), _
shB.Range("A1").End(xlDown))
Set rngA = shA.Range(rngA, rngA.End(xlDown))
v = rngA.Value
j = 0
ReDim v1(1 To rngB.Count + rngA.Count, 1 To 2)
For i = LBound(v, 1) To UBound(v, 1)
s = v(i, 1)
Set rng = rngB.Find(What:=s, _
After:=rngB(rngB.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
j1 = 0
If Not rng Is Nothing Then
sAddr = rng.Address
Do
j = j + 1
j1 = j1 + 1
If j1 = 1 Then _
v1(j, 1) = v(i, 1)
v1(j, 2) = rng.Offset(0, 1).Text
Set rng = rngB.FindNext(rng)
Loop Until rng.Address = sAddr
Else
j = j + 1
v1(j, 1) = v(i, 1)
v1(j, 2) = "Not Found"
End If
Next i
rngA.Resize(UBound(v1), 2).Value = v1
End Sub

worked for me. It assumes that on SheetB that the data starts in A1.
Adjust to fit your situation. The ActiveCell when you run the macro should
be the cell containing PartA on sheetA.

--
Regards,
Tom Ogilvy

"Michael from Austin" wrote:

I need VB code to do the following. Take active cell from sheet A and look
for it on sheet B. If found return a value if not found return, "not found"
and then add a row under the row it returned a value to. It would continue to
look for the active cell from sheet A and repeat the above until it got to
the bottom of sheet B. It would then go down an active cell on sheet A and
skip the lookup it the active cell is empty until it found an active cell on
sheet A that was not and then it would do it all over again for say a counter
of 100...

first active cell = Part A from sheet A


Sheet B Value to Return
Part G 1-Jul-07
Part A 2-Aug-07
Part E 30-Dec-06
Part A 25-Jul-07
Part F 15-Oct-06

before Sheet A Value returned here
Part A
Part B
Part C
Part D
Part E

Sheet A Value returned here
after Part A 2-Aug-07
25-Jul-07
Part B not found
Part C not found
Part D not found
Part E 30-Dec-06

--
Regards,
Michael