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