PDA

View Full Version : select columns A through D for each cell value in column A that equals a variable



tx7399
06-23-2012, 08:38 PM
Hi everyone,

Column A contains dates. A variable number of contiguous rows can have the same date in Col A.
I need to select columns A through Column D for each row where the date in Col A equals a user input date.
I then will send the selection to outlook mail.
For example: user input = 5/1/12

Col A Col B Col C Col D
date time user comments

5/1/12 0830 Fred on duty
5/1/12 1000 Fred something entered
5/1/12 1200 Fred lunch
5/1/12 1700 Fred off duty
5/9/12 0830 Fred on duty (new date)(do not select)

Any help would be greatly appreciated.

mikerickson
06-24-2012, 02:18 AM
If all the dates are contigous then this should work.
Sub test()
Dim uiDate As String
Dim firstCell As Range, lastCell As Range

uiDate = Application.InputBox("Enter date", Default:="5/1/12")
If uiDate = "False" Then Exit Sub: Rem canceled
If Not IsDate(uiDate) Then Exit Sub: Rem validate user entry

With Sheet3.Range("A:A"): Rem adjust
Set firstCell = .Find(DateValue(uiDate), After:=.Cells(.Rows.Count, 1), LookIn:=xlFormulas, LookAt:=xlWhole, SearchDirection:=xlNext)
Set lastCell = .Find(DateValue(uiDate), After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlWhole, SearchDirection:=xlPrevious)
End With

Range(firstCell, lastCell).Resize(, 4).Select
End Sub

If the matching cells are not contiguous,
Sub aTest()
Dim uiDate As String, soughtDate As Date
Dim firstCell As Range, foundCell As Range, foundRange As Range

uiDate = Application.InputBox("Enter date", Default:="5/1/12")
If uiDate = "False" Then Exit Sub: Rem canceled
If Not IsDate(uiDate) Then Exit Sub: Rem validate user entry

soughtDate = DateValue(uiDate)

With Sheet3.Range("A:A"): Rem adjust
Set firstCell = .Find(DateValue(uiDate), after:=.Cells(.Rows.Count, 1), SearchDirection:=xlNext, LookIn:=xlFormulas, LookAt:=xlWhole)

If firstCell Is Nothing Then
Rem nothing found
Beep
Else
Set foundCell = firstCell
Set foundRange = foundCell

Do
Set foundRange = Application.Union(foundRange, foundCell)
Set foundCell = .FindNext(after:=foundCell)
Loop Until foundCell.Address = firstCell.Address

With foundRange
Application.Intersect(.EntireRow, .Cells(1, 1).Resize(1, 4).EntireColumn).Select
End With
End If
End With

End Sub

snb
06-24-2012, 05:04 AM
or simply use autofilter:


sub snb()
with columns(1)
.autofilter 1,"=" & textbox1.text
for each cl in specialcells(12)
if cl.row > 1 then
_ - _ - _
end if
next
.autofilter
end with
End sub

tx7399
06-24-2012, 06:47 AM
Thanks mikericson and snb. Code worked great.:clap: