CODEWITHSUNDEEP
vbaexcel
tveitno
tveitno

Reputation: 1

Search button using time vba

Trying to create a search button that, when a time is entered in cell (B10) and button pressed, will copy values to the sheet. Tried a few tutorials but I keep doing something wrong.

Search function is on sheet1 and all my data is on sheet2. Date and time (m/dd/yyyy hh:mm:ss) are entered in cell B10 and info should be copy/pasted into cells D10:I10. Time on sheet2 is in A, while the data I want is B to G. The search should only return one row of values.

What did I do wrong in my code?

Sub search()

Dim erow As Long
Dim ws As Worksheet
Dim lastrow As Long
Dim count As Integer

lastrow = Sheets("Sheet2").Cells(Rows.count, 1).End(xlUp).Row

For x = 2 To lastrow

If Sheets("Sheet2").Cells(x, 1) = Sheet1.Range("B10") Then
Sheet1.Range("D10") = Sheets("Sheet2").Cells(x, 2)
Sheet1.Range("E10") = Sheets("Sheet2").Cells(x, 3)
Sheet1.Range("F10") = Sheets("Sheet2").Cells(x, 4)
Sheet1.Range("G10") = Sheets("Sheet2").Cells(x, 5)
Sheet1.Range("H10") = Sheets("Sheet2").Cells(x, 6)
Sheet1.Range("I10") = Sheets("Sheet2").Cells(x, 7)
End If

End Sub

Upvotes: 0

Views: 56

Answers (2)

user3598756
user3598756

Reputation: 29421

you could try:

Option Explicit

Sub search2()
    Dim myCell As Range, foundCell As Range

    Set myCell = Worksheets("Sheet01").Range("B10")
    With Worksheets("Sheet02")
        Set foundCell = .Range("A1", .Cells(.Rows.count, 1).End(xlUp)).Find(what:=myCell.Value, LookIn:=xlFormulas, lookat:=xlWhole) '<--| try and find wanted date/time
        If Not foundCell Is Nothing Then myCell.Offset(, 2).Resize(, 6).Value = foundCell.Offset(, 1).Resize(, 6).Value '<--| if found then copy its adjacent 6 columns to Sheet1 "D10:E10" range
    End With
End Sub

Upvotes: 0

Brandon Barney
Brandon Barney

Reputation: 2392

Is Sheet1 declared as a variable? I dont see anywhere that you are setting it. Try this instead:

Sub search()

    Dim erow As Long

    Dim wbTarget as Workbook
    Dim wsTarget as Worksheet

    Dim wsSource as Worksheet

    Dim ws As Worksheet
    Dim lastrow As Long
    Dim count As Integer

    Dim r as Range

    Set wbTarget = ThisWorkbook
    Set wsTarget = wbTarget.Sheets("Sheet1")

    Set wsSource = wbTarget.Sheets("Sheet2")

    lastrow = wsSource.Cells(wsSource.Rows.count, 1).End(xlUp).Row

    For x = 2 To lastrow

        If wsSource.Cells(x, 1) = wsTarget.Range("B10") Then
            Set r = wsSource.Cells(x, 2).Resize(8, 1)
            wsTarget.Range("D10:I10").Value = r.Value
            Set r = Nothing
        End If
    Next

End Sub

Upvotes: 1

Related Questions