For Each Next Help

[rockchalk33]

Need a little help with writing a For Each Next loop. I have a set of data on Sheet2 with names in column A, dates in column B, addresses in column C, city in column D, state in column E, and zip in column F. Ideally I need an input box to pop up, the user enters a date and then for every person with that same date it will take their information from Sheet2 in column A, C, D, E, F and move them to Sheet3.

Thanks,

Devin

 

[My Aswer Is This]

When you say "Move" do you mean copy to other sheet and leave original sheet as is.
Or do you mean copy to sheet 3 and delete from sheet 2

And are these two sheets named "Sheet1" and "Sheet2"

 

[rockchalk33]

Yes, just a copy and leave original sheet as is. There are only three sheets and are named Sheet1, Sheet2, and Sheet3 respectively.

Thanks

 

[tygrrboi]

Maybe something like this... Dates are tricky and you sometimes have to figure out / play with how they are formatted and how you read them and compare them with VBA...

Dim C as Range, R as Range
Dim destinationLastRow as Integer
Dim userDate as String

Set R = Sheets("Sheet2").Range("B1:B100") 'Change this to suit your needs.
With Sheets("Sheet3")
    destinationLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

userDate = InputBox("Please type a date to search. (in YYYY/MM/DD format)")
If userDate = vbnullstring then Exit Sub

For each C in R
    If Format(C.Value, "YYYY/MM/DD") = userDate Then
        Sheets("Sheet3").Range("A" & destinationLastRow).Value = C.Offset(0,-1).Value
        C.Offset(0,1).Resize(1,4).Copy
        Sheets("Sheet3").Range("B" & destinationLastRow).Paste 
        destinationLastRow = destinationLastRow + 1
    End If
Next C

 

[JLGWhiz]

A filter would be faster than a loop.

Sub sh2Tosh3()
Dim dt As Date
dt = CDate(InputBox("Enter the date to search in 'mm/dd/yyyy' format", "DATE TO SEARCH"))
    With Sheets("Sheet2")
        .UsedRange.AutoFilter 2, dt
        .UsedRange.Offset(1).SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2)
    End With
End Sub

 

[My Aswer Is This]

Looks like you have a lot of help here. I will move on to some other question.

 

[rockchalk33]

Thanks for the help all!

 

[JLGWhiz]

Thanks for the help all!

Happy to assist,
regards, JLG