Lookup or Index or Match, not sure.

[ForSale]

On sheet1 I have a continually updating list. A:A contains dates, B:B
and C:C contain ID numbers. Some dates will be duplicated and some ID
numbers will be duplicated. On sheet2 I have a calendar and date box.
When the user enters a date into sheet2!B1 I need a5:c? to generate all
the lines from sheet1 that have the same date.
For example:
sheet2!B1 = 6/1/06, sheet2!a5 should say 6/1/06, sheet2!b5 should say
1234 and sheet2!c5 should say 9876. This should repeat all the way
down until there are no more dates on sheet1 that match sheet2!b1.

I hope this makes sense. Please let me know if I need to elaborate or
show a detailed example. Thanks.

 

[Die_Another_Day]

Try this. First right click the "Sheet2" tab in excel and click "View
Code" and paste this in:

Private Sub Worksheet_Change(ByVal Target As Range)
Call FindMatch(Target)
End Sub

Then you will need to insert a new module in the VB editor and paste
this code:

Sub FindMatch(Target As Range)
Dim DateSearch As String
Dim nRow As Double 'Next Row to paste on
Dim Cnt As Double
If Not Target.Address = "$B$1" Then Exit Sub
Application.ScreenUpdating = False
DateSearch = Target.Value
If DateSearch <> "" Then
Range("A5").Select
If Range("A5").Value = "" Then
nRow = 5
ElseIf Range("A6").Value = "" Then
nRow = 6
Else
nRow = Selection.End(xlDown).Row
End If
Sheets(1).Activate
Range("A1").Activate
For Cnt = 1 To Selection.End(xlDown).Row
If Cells(Cnt, 1).Value = DateSearch Then
Range(Cells(Cnt, 1), Cells(Cnt, 3)).Copy
Sheets(2).Activate
Cells(nRow, 1).PasteSpecial xlPasteAll
nRow = nRow + 1
Sheets(1).Activate
End If
Next
End If
Sheets(2).Activate
Application.ScreenUpdating = True
End Sub

Post back if it doesn't work

HTH

Die_Another_Day

 

[ForSale]

Works great! Thanks.

What should I change if I want the data to copy to a different locatio
on sheet2? I want the data to start in B6 now on sheet2.

Thanks

 

[Bob Phillips]

Sub FindMatch(Target As Range)
Const StartCell As String = "B6"
Dim SearchVal
Dim cell As Range
Dim i As Long
Dim FirstAddress As String

If Not Target.Address = "$B$1" Then Exit Sub
Application.ScreenUpdating = False
SearchVal = Range("B1").Text
With Worksheets("Sheet1").Range("A:A")
Set cell = .Find(SearchVal, LookIn:=xlValues)
If Not cell Is Nothing Then
FirstAddress = cell.Address
Do
cell.Resize(1, 4).Copy Range(StartCell).Offset(i, 0)
i = i + 1
Set cell = .FindNext(cell)
Loop While Not cell Is Nothing And cell.Address <> FirstAddress
End If
End With

Application.ScreenUpdating = True
End Sub




--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Die_Another_Day]

Bob, I like your code but I don't understand how it is copying into
sheet2 in this line:

cell.Resize(1, 4).Copy Range(StartCell).Offset(i, 0)

can you please explain this for me.

Also should we add LookAt:=xlWhole to the .find statement to make sure
that it doesn't grab cells containing the partial data? for example:

search for "1/1/06"
if cell contained this "11/1/06" it would get copied with your code.

Thx

Die_Another_Day

 

[Bob Phillips]

It assumes that Sheet2 is active. The Find looks across to Sheet1 (without
activating it), gets the data, and copies it that activesheet (Sheet2).

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[ForSale]

Thanks to both. Unfortunately I don't understand most of this, so I'
having a hard time altering it to fit my sheet.

On sheet1, there are 10 columns, A:K. You have helped me move A:
over, now I also need to move F:K also.

In other words, I need sheet1!A:B to copy to sheet2!A:B, then I nee
sheet1!F:K to copy to sheet2!E:J.

Thanks again

 

[ForSale]

Also, can we throw in a clear of some sort. Right now if I run this fo
6/1/06 it puts three results into sheet2. If I change the date t
6/2/06 (which only has two matches), sheet2 shows two with 6/2/06 an
then one with 6/1/06.

I think we need to put a clear type thing in there somewhere so i
starts fresh each time.

Thanks

 

[ForSale]

Bob,
With your code I have figured out how to move all of the cells that I
need. I am still having trouble clearing sheet2 before running
FindMatch. I have named the range that needs to be cleared 'field'.

Any ideas?

Thanks.

 

[Bob Phillips]

If you post the code that you have now that moves all the correct data, I
will add the clear.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[ForSale]

Sub FindMatch(Target As Range)
Const StartCell As String = "B6"
Dim SearchVal
Dim cell As Range
Dim i As Long
Dim FirstAddress As String

If Not Target.Address = "$B$1" Then Exit Sub
Application.ScreenUpdating = False
SearchVal = Range("B1").Text
With Worksheets("Data Entry").Range("A:A")
Set cell = .Find(SearchVal, LookIn:=xlValues)
If Not cell Is Nothing Then
FirstAddress = cell.Address
Do
cell.Resize(1, 10).Copy Range(StartCell).Offset(i, 0)
i = i + 1
Set cell = .FindNext(cell)
Loop While Not cell Is Nothing And cell.Address <> FirstAddress
End If
End With

Application.ScreenUpdating = True
End Sub