SirSchiz
New Member
- Joined
- May 4, 2011
- Messages
- 24
Hi All,
I apologize, I have to cross post from another site for greater exposure. Original post here: http://www.excelforum.com/excel-pro...ing-selecting-and-copying-to-a-new-sheet.html
If this has been solved elsewhere in this Forum Based "Wealth of Knowledge" I do apologize.
I have a problem that I have been trying to solve for 2 weeks now
.
I need to fix a code that searches for a particular string via Input Box. The term could be either a Text or Numeric string, it also needs to have a "Contains" clause meaning the term could vary depending on how I receive the data. For Example:
Tom Jones
1223
1235456
1231234645
1`23412341234
tom jones
6654332
456789
23456789
Tom J.
The data will always be in Column A, and could go until say 60,000 rows down(this varies).
The code I've found and tried so far finds the term then copies everything in between the searched term to column B. I need it to copy from the first found term until the next occurrence, then minus 1 row, copy that selection to a new worksheet, and loop until all occurrences have been found. It would need to have some message boxes if nothing was found or if there was an error within a certain section.
I know this is asking a lot, however my VBA skills are about beginner to intermediate level, so please be kind in any explanations. I thank anyone who can help with this. I would be clad to buy the solver of this problem a Brew or Coke, which ever your fancy!
I Have SAMPLE Sheets I can PM, I don't seem to be able to upload attachments.
=========CODE STARTS BELOW===============
Sorry I goofed. I'm not sure how to post Code yet. I will try to fix!!
I apologize, I have to cross post from another site for greater exposure. Original post here: http://www.excelforum.com/excel-pro...ing-selecting-and-copying-to-a-new-sheet.html
If this has been solved elsewhere in this Forum Based "Wealth of Knowledge" I do apologize.
I have a problem that I have been trying to solve for 2 weeks now
I need to fix a code that searches for a particular string via Input Box. The term could be either a Text or Numeric string, it also needs to have a "Contains" clause meaning the term could vary depending on how I receive the data. For Example:
Tom Jones
1223
1235456
1231234645
1`23412341234
tom jones
6654332
456789
23456789
Tom J.
The data will always be in Column A, and could go until say 60,000 rows down(this varies).
The code I've found and tried so far finds the term then copies everything in between the searched term to column B. I need it to copy from the first found term until the next occurrence, then minus 1 row, copy that selection to a new worksheet, and loop until all occurrences have been found. It would need to have some message boxes if nothing was found or if there was an error within a certain section.
I know this is asking a lot, however my VBA skills are about beginner to intermediate level, so please be kind in any explanations. I thank anyone who can help with this. I would be clad to buy the solver of this problem a Brew or Coke, which ever your fancy!
I Have SAMPLE Sheets I can PM, I don't seem to be able to upload attachments.
=========CODE STARTS BELOW===============
Sorry I goofed. I'm not sure how to post Code yet. I will try to fix!!
Code:
[B][FONT=Arial][SIZE=2][COLOR=#000000][B][FONT=Arial][SIZE=2][COLOR=#000000][VBA]Sub SearchAndCopy() Dim rngTemp As Range Dim rngFind As Range Dim rngFirst As Range Dim rngLast As Range Dim strFirstAddress As String Dim lngRow As Long Dim varTypedIn lngRow = Range("A" & Rows.Count).End(xlUp).Row + 1 varTypedIn = InputBox("Please Enter Search Term: ") With Range("A:A") 'This in my variable to search for the term within A:A range Set rngFind = .Find(varTypedIn, .Cells(lngRow, 1), LookIn:=xlValues, lookat:=xlPart) If Not rngFind Is Nothing Then strFirstAddress = rngFind.Address 'Here it's setting the first found terms cell address. Set rngFirst = rngFind.Offset(1) 'I'm foggy with this Offset, I've read on it, but it's not clicking. Set rngTemp = rngFirst Set rngFind = .FindNext(rngFind) Do While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress Set rngLast = rngFind.Offset(-1) Set rngTemp = Union(rngTemp, Range(rngFirst, rngLast)) Set rngFirst = rngFind.Offset(1) Set rngFind = .FindNext(rngFind) Loop End If End With If Not rngTemp Is Nothing Then rngTemp.Copy Range("B1") 'I've tried changing this range, but I think the offset properties above are throwing this off.. End Sub[VBA][/COLOR][/SIZE][/FONT][/B][/COLOR][/SIZE][/FONT][/B][CODE]
Last edited: