Disconnected
11-26-2012, 02:52 PM
Abstract: Using a prompt, user enters numbers to search. Certain values related to that numerical search end up in a new spreadsheet.
Concrete:
In Worksheet 2, Column D, Row 1 the cell contains a header which will not be searched.
I want the search to start in Worksheet 2, Column D, Row 2 until the end of Column D (Rows.Count) as the number of rows will always change.
For every row containing the data (theAppID variable) the data will be formatted/copied [which I will figure out later].Problem:
Every time I search I get a type match error. :(
Example: I hit the button, get prompted, enter 2367, hit enter, and type mismatch fail.
I don't understand why it's failing because all I'm doing is using find to match the number input to each row and format/copy data... why wouldn't it recognize the number?
All my research left me confounded.
Where the code fails has been bolded.
Thank you for your help. :o)
Sub appIDSearch()
Dim oRange, aCell, bCell, newRange As Range
Dim ws, wsAll As Worksheet
Dim ExitLoop As Boolean
Dim i As Integer
On Error GoTo Err
Set ws = Worksheets(2)
Set oRange = ws.Columns(4)
'Creates input box for the search term.
Search:
Sheets("Macros").Select
theAppID = InputBox("Please enter AppID.", "Searching...")
If theAppID = "" Then
Exit Sub
End If
'Creates a new worksheet and range to dump the data found in aCell during the loop.
Set newRange = Worksheets.Add(After:=Worksheets(Worksheets.Count)).Range("A1")
ActiveSheet.Name = theAppID
'Defines the range during the search. oRange is the 4th column of the 2nd worksheet,
'which will always be the AppID.
Set aCell = oRange.Find(What:=theAppID, After:=ws.Range("D2:D" & Rows.Count), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'Loops through all of the cells. Loop will exit once it wraps back around and
'aCell.Row becomes >= bCell.Row
If Not aCell Is Nothing Then
aCell.EntireRow.Copy newRange
Set newRange = newRange.Offset(1, 0)
Set bCell = aCell
Do
Set bCell = oRange.FindNext(After:=bCell)
If Not bCell Is Nothing Then
If aCell.Row = bCell.Row Then
Exit Do
Else
bCell.EntireRow.Copy newRange
Set newRange = newRange.Offset(1, 0)
End If
Else
Exit Do
End If
Loop
Else
MsgBox theText & " not Found"
End If
'Dialog confirming which application data/sheet was added.
MsgBox theText & " AppID has been added to a new sheet."
'Dialog confirming if the users wishes to continue the search.
runAgain = InputBox("Search for another application ID? Type Y or N.", "Searching again...")
If runAgain = "N" Or runAgain = "n" Then
For i = 1 To ActiveWorkbook.Sheets.Count
If i = ActiveWorkbook.Sheets.Count Then
Sheets(1).Select
Range("A1").Select
Exit Sub
Else
Sheets(2).Select
Sheets(2).Range("A1:G1").Copy
ActiveWorkbook.Sheets(i).Next.Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End If
Next
Exit Sub
Else
GoTo Search
End If
Sheets("Macros").Activate
Exit Sub
Err:
MsgBox Err.Description
End Sub
Concrete:
In Worksheet 2, Column D, Row 1 the cell contains a header which will not be searched.
I want the search to start in Worksheet 2, Column D, Row 2 until the end of Column D (Rows.Count) as the number of rows will always change.
For every row containing the data (theAppID variable) the data will be formatted/copied [which I will figure out later].Problem:
Every time I search I get a type match error. :(
Example: I hit the button, get prompted, enter 2367, hit enter, and type mismatch fail.
I don't understand why it's failing because all I'm doing is using find to match the number input to each row and format/copy data... why wouldn't it recognize the number?
All my research left me confounded.
Where the code fails has been bolded.
Thank you for your help. :o)
Sub appIDSearch()
Dim oRange, aCell, bCell, newRange As Range
Dim ws, wsAll As Worksheet
Dim ExitLoop As Boolean
Dim i As Integer
On Error GoTo Err
Set ws = Worksheets(2)
Set oRange = ws.Columns(4)
'Creates input box for the search term.
Search:
Sheets("Macros").Select
theAppID = InputBox("Please enter AppID.", "Searching...")
If theAppID = "" Then
Exit Sub
End If
'Creates a new worksheet and range to dump the data found in aCell during the loop.
Set newRange = Worksheets.Add(After:=Worksheets(Worksheets.Count)).Range("A1")
ActiveSheet.Name = theAppID
'Defines the range during the search. oRange is the 4th column of the 2nd worksheet,
'which will always be the AppID.
Set aCell = oRange.Find(What:=theAppID, After:=ws.Range("D2:D" & Rows.Count), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'Loops through all of the cells. Loop will exit once it wraps back around and
'aCell.Row becomes >= bCell.Row
If Not aCell Is Nothing Then
aCell.EntireRow.Copy newRange
Set newRange = newRange.Offset(1, 0)
Set bCell = aCell
Do
Set bCell = oRange.FindNext(After:=bCell)
If Not bCell Is Nothing Then
If aCell.Row = bCell.Row Then
Exit Do
Else
bCell.EntireRow.Copy newRange
Set newRange = newRange.Offset(1, 0)
End If
Else
Exit Do
End If
Loop
Else
MsgBox theText & " not Found"
End If
'Dialog confirming which application data/sheet was added.
MsgBox theText & " AppID has been added to a new sheet."
'Dialog confirming if the users wishes to continue the search.
runAgain = InputBox("Search for another application ID? Type Y or N.", "Searching again...")
If runAgain = "N" Or runAgain = "n" Then
For i = 1 To ActiveWorkbook.Sheets.Count
If i = ActiveWorkbook.Sheets.Count Then
Sheets(1).Select
Range("A1").Select
Exit Sub
Else
Sheets(2).Select
Sheets(2).Range("A1:G1").Copy
ActiveWorkbook.Sheets(i).Next.Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End If
Next
Exit Sub
Else
GoTo Search
End If
Sheets("Macros").Activate
Exit Sub
Err:
MsgBox Err.Description
End Sub