K
kaydee
Hi All,
I found code and tried to change it to make it fit me worksheet. I am
using a inputbox to get a date range for report selection. The following
code highlights and copies the first matchof my criteria set then I get the
Err_Execute message in the sheet that I am copying to. Can someone tell me
what is wrong with my code? Thanks
Kim
Sub SearchForString()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim LSearchValue As String
Dim LSearchValue2 As String
Dim checkDate As Boolean
Dim checkDate2 As Boolean
On Error GoTo Err_Execute
checkDate = False
Do
LSearchValue = InputBox("Enter Start Date 'mm/dd/yyyy'.", "Enter value")
If IsDate(LSearchValue) Then
dt = CDate(LSearchValue)
checkDate = True
Else
MsgBox ("You provided an invalid Start Date value")
LSearchValue = InputBox("Enter Start Date 'mm/dd/yyyy'.", "Enter
value")
checkDate = False
End If
Loop Until checkDate = True
checkDate2 = False
LSearchValue2 = InputBox("Enter End Date 'mm/dd/yyyy'.", "Enter value")
Do
If IsDate(LSearchValue2) Then
dt2 = CDate(LSearchValue2)
checkDate2 = True
Else
MsgBox ("You provided an invalid End Date value")
LSearchValue2 = InputBox("Enter End Date 'mm/dd/yyyy'.", "Enter
value")
checkDate2 = False
End If
Loop Until checkDate2 = True
'Start search in row 6
LSearchRow = 6
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
'If value in column E = LSearchValue, copy entire row to Sheet2
If Range("J" & CStr(LSearchRow)).Value >= dt And Range("J" &
CStr(LSearchRow)).Value <= dt2 Then
'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet2 in next row
Sheets("Results").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Report").Select
Else
Sheets("Report").Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied to the Report tab."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
I found code and tried to change it to make it fit me worksheet. I am
using a inputbox to get a date range for report selection. The following
code highlights and copies the first matchof my criteria set then I get the
Err_Execute message in the sheet that I am copying to. Can someone tell me
what is wrong with my code? Thanks
Kim
Sub SearchForString()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim LSearchValue As String
Dim LSearchValue2 As String
Dim checkDate As Boolean
Dim checkDate2 As Boolean
On Error GoTo Err_Execute
checkDate = False
Do
LSearchValue = InputBox("Enter Start Date 'mm/dd/yyyy'.", "Enter value")
If IsDate(LSearchValue) Then
dt = CDate(LSearchValue)
checkDate = True
Else
MsgBox ("You provided an invalid Start Date value")
LSearchValue = InputBox("Enter Start Date 'mm/dd/yyyy'.", "Enter
value")
checkDate = False
End If
Loop Until checkDate = True
checkDate2 = False
LSearchValue2 = InputBox("Enter End Date 'mm/dd/yyyy'.", "Enter value")
Do
If IsDate(LSearchValue2) Then
dt2 = CDate(LSearchValue2)
checkDate2 = True
Else
MsgBox ("You provided an invalid End Date value")
LSearchValue2 = InputBox("Enter End Date 'mm/dd/yyyy'.", "Enter
value")
checkDate2 = False
End If
Loop Until checkDate2 = True
'Start search in row 6
LSearchRow = 6
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
'If value in column E = LSearchValue, copy entire row to Sheet2
If Range("J" & CStr(LSearchRow)).Value >= dt And Range("J" &
CStr(LSearchRow)).Value <= dt2 Then
'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet2 in next row
Sheets("Results").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Report").Select
Else
Sheets("Report").Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied to the Report tab."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub