Looking up and Pasting Data

[technomonkey]

Excel VBA - Looking up and Pasting Data

Hi all, I am trying to lookup a date with a description next to it on one worksheet and list all those matches vertically on another worksheet, if the date matches the current date. Basically if i have data:

01/03/2006 Mailing 2
01/03/2006 Mailing 3
03/03/2006 Mailing 4
03/03/2006 Email 5
04/03/2006 Mailing 5

I would like for it for example, for today to bring back on another sheet:

Mailing 4
Email 5

I don't mind if you need to enter a day or month to display this data. It would be even more useful if someone new how I could enter a month and bring back those items listed within that month.

Thanks.

[Cyberdude]

Hi, techno! Welcome to VBAX!
The following code demonstrates how you can write a macro to extract the data (I think). I put the results in a string array. What you do with it after that is up to you. I'm sure there is a more elegant way to do this job, but this can give you something to play with:
Sub GetData()
Dim FoundData(1 To 5) As String, N As Long, K As Long
Dim MthToday As String, Msg As String
MthToday = Format(Date, "mm")
With Range("D15")
For N = 0 To 4
If Left(.Offset(N, 0), 2) = MthToday _
Then
K = K + 1
FoundData(K) = .Offset(N, 0)
End If
Next N
End With
For N = 1 To K
Msg = Msg & FoundData(N) & vbCr
Next N
MsgBox Msg
End Sub Hope this helps. :beerchug:

P.S. I used the list in your example and assummed that the first value in the list is in cell "D15".

[Cyberdude]

Whoops! I didn't notice that you had stripped the date off the input data. Change
FoundData(K) = .Offset(N, 0)
to be something like
FoundData(K) = Right(.Offset(N,0),9)
which will remove the date.

[Cyberdude]

Another whoops! You also want to be prompted for the month number, so here's my last effort:
Sub GetData()
Dim FoundData(1 To 5) As String, N As Long, K As Long, CurrVal As String
Dim MthToday As String, Msg As String
MthToday = InputBox("Enter the month number to be extracted:")
MthToday = Right("0" & MthToday, 2)
With Range("D15")
For N = 0 To 4
CurrVal = .Offset(N, 0)
If Left(CurrVal, 2) = MthToday _
Then
K = K + 1
FoundData(K) = Right(CurrVal, Len(CurrVal) - InStr(1, CurrVal, " "))
End If
Next N
End With
For N = 1 To K
Msg = Msg & FoundData(N) & vbCr
Next N
MsgBox Msg
End Sub