PDA

View Full Version : Solved: Find cells that contain a string, extract it, then cocatenate to value in Col 15



frank_m
04-10-2012, 01:09 AM
I wrote this procedure to find cells that conatin the word "Void", clear it only if that is the only value,
then prefix it to the value in Column(15), put "V" in the Column(1) cell and color the row.

My code works well except as you can see I am only clearing the word "void" when it is the only value in the cell,
when what I really need to do is to extract it as to leave other values that may be within that cell intact.

There are fewer than 75 intances in 20,000 records, so I prefer to modify one match at a time, so I can review the other data in the row.

Dim Rng As Range
Dim Found As Range
Dim stringToFind As String
stringToFind = "Void"
Set Found = Cells.Find(What:=stringToFind, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext _
, MatchCase:=False)

If Not Found Is Nothing Then
Found.Activate
With ActiveCell
.EntireRow.Cells(1).Value = "V"
If Not UCase(Left(.EntireRow.Cells(15).Value, 4)) = "VOID" Then
.EntireRow.Cells(15).Value = "Void" & .EntireRow.Cells(15).Value
Set Rng = ActiveCell.EntireRow.Cells(1).Resize(, 30)
Rng.Interior.ColorIndex = 8
End If
If Len(.Value = 4) Then .ClearContents
End With
Else
MsgBox "No Match Found"
End If

Thanks

Bob Phillips
04-10-2012, 01:38 AM
My code works well except as you can see I am only clearing the word "void" when it is the only value in the cell,
when what I really need to do is to extract it as to leave other values that may be within that cell intact.

Frank,

You say that you '...are clearing the word "void" when it is the ONLY value in the cell ...', but then you say that you need '... to extract it as to leave OTHER values that may be within that cell intact ...'.

That seems a contradictory statement to me.

Bob Phillips
04-10-2012, 01:45 AM
There also is no loop here that I can see, so it only processes one cell.

BTW, shouldn't this line

If Len(.Value = 4) Then .ClearContents

be

If Len(.Value) = 4 Then .ClearContents

frank_m
04-10-2012, 07:27 AM
There also is no loop here that I can see, so it only processes one cell.
I only want to go to and process the first match, then stop so I can visualy review the other data in the row, then click the button again to go to the next and so on.


BTW, shouldn't this line

If Len(.Value = 4) Then .ClearContents
be
If Len(.Value) = 4 Then .ClearContents

Yes you're right, I goofed there.


You say that you '...are clearing the word "void" when it is the ONLY value in the cell ...', but then you say that you need '... to extract it as to leave OTHER values that may be within that cell intact ...'.

That seems a contradictory statement to me.
Looks ok to me, but I do have a habit of getting the "intended meaning" using the wrong words burnt into my brain some times, so let me try wording it differently:
If the word "Void" is found within a string, or by itself, I want to remove it and prefix the Column(15) String with "Void" and put a "V" in the column(1) cell, plus color the row.

Edit:The intention is to only have the word "Void" at the begining of the Column(15) string

Bob Phillips
04-10-2012, 08:31 AM
What column will you be searching? I ask as column O will have Void in it and presumably you don't want to 'find' that.

frank_m
04-10-2012, 09:21 AM
The users have added "Void" randomly in 20 columns.
And even if they did put "Void" in column(O), some times they put it at the end of the string when I want it at the begining.

-- I'm wanting to make all the void rows marked in the same way. --
Column(O) Prefixed with "Void'" and Column(A) with its value the letter "V"

Bob Phillips
04-10-2012, 09:43 AM
Then I am at a loss, because isn't that exactly what your code does?

frank_m
04-10-2012, 10:43 AM
I've attached a sample file to show the result that my code gives and the result that I want.

Edit: Changed attachment to Rev3 (corrected row 18 and row 22 in the desired results sheet)

Edit#2: I see now what I need to do to correct the issue where my Code is not highlighting row# 20, but I need help with the other issues demonstrated in the desired results sheet of the attached sample.

Thanks

Bob Phillips
04-10-2012, 01:51 PM
Try this


Private Sub CommandButton1_Click()
Dim Rng As Range
Dim Found As Range
Dim stringToFind As String
Dim firstAddress As String
Dim fExit As Boolean
Dim fNext As Boolean

stringToFind = "Void"

Set Found = Cells.Find(What:=stringToFind, _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not Found Is Nothing Then

firstAddress = Found.Address

Do

fNext = Found.Column <> 15 Or (Found.Column = 15 And Left$(Found.Value, 4) <> stringToFind)

If Not fNext Then

Set Found = Cells.FindNext(Found)
fExit = Found Is Nothing Or Found.Address = firstAddress
End If
Loop Until fNext Or fExit

If Not fExit Then

With Found

If UCase(.Value) = UCase(stringToFind) Then

.ClearContents
Else

.Value = Replace(.Value, " " & stringToFind, "")
.Value = Replace(.Value, stringToFind, "")
.Value = Replace(.Value, " " & LCase(stringToFind), "")
.Value = Replace(.Value, LCase(stringToFind), "")
End If

.EntireRow.Cells(1).Value = "V"

.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, " " & stringToFind, "", vbTextCompare)
.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, stringToFind, "")
.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, " " & LCase(stringToFind), "", vbTextCompare)
.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, LCase(stringToFind), "")
.EntireRow.Cells(15).Value = stringToFind & .EntireRow.Cells(15).Value
Set Rng = .EntireRow.Cells(1).Resize(, 30)
Rng.Interior.ColorIndex = 8
End With
Else

MsgBox "No Match Found"
End If
End If
End Sub

frank_m
04-10-2012, 03:46 PM
HI Bob,

Wow, That works very well..

Edit: I added a Scroll in there so the matchs are always visible, being that I have 20,000 rows to check and about 75 corrections to view and process, but otherwise it is perfect.

-- Awesome work there kind Sir :bow:
Else

.Value = Replace(.Value, " " & stringToFind, "")
.Value = Replace(.Value, stringToFind, "")
.Value = Replace(.Value, " " & LCase(stringToFind), "")
.Value = Replace(.Value, LCase(stringToFind), "")

End If

ActiveWindow.ScrollRow = Found.Row - 10 ' to keep matchs in view
'(the - 10 allows me to view several rows above each match)

.EntireRow.Cells(1).Value = "V"I may have evetualy come up with using Replace, but the trick of both stopping at each row and not selecting any Cells was frying my brain.


Thank you much :friends:

Bob Phillips
04-10-2012, 04:15 PM
It fried mine a bit too Frank. Having to allow for column O, and the combinations of void made the code a mite unwieldy.

frank_m
04-10-2012, 04:28 PM
It fried mine a bit too Frank. Having to allow for column O, and the combinations of void made the code a mite unwieldy.

Sorry about that Bob. I didn't mean to harness you with a BIG time eating task.

I'll definetly will remember you the next time I can afford to send you a case of your favorite wiskey. If and when that time comes I'll get you to remind me of what you like as that has slipped my mind, much in the way vba code so often does.

Edit: In hindsight I should have loosened up the rules for Column(O)

Thanks again.

Bob Phillips
04-11-2012, 12:11 AM
No bother Frank, much of what we give is straight off the top, it is good to have it think about it more :). Now I properly understand the requirement I would like to tidy that code up, but we'll leave well enough alone (until you need too take it further).

frank_m
04-11-2012, 01:00 AM
Now I properly understand the requirement I would like to tidy that code up, but we'll leave well enough alone (until you need too take it further).
Hi again Bob,

Yes, best to wait just incase I decide that it needs any other feature.
When that time comes it would be nice if it would stop at the matched row and not make any changes (including not coloring the row), until after I click the button a second time, or a yes no msgbox, and a 3rd click so i can see the changes were made. - Currently it requires several clicks in rows that need several changes, but it does show me all of the results before moving to the next match, which is awesome.

In other words there are occasionally a couple more clicks required to run the routine than what technically should be necessary, but I'm very pleased with the functionality regardless - Thanks again for your generosity.

Bob Phillips
04-11-2012, 01:18 AM
Maybe what would be nice would be three buttons.

The first button makes ALL of the changes on the next row and colours the line colour A.

The second button could reverse that change (for the last matched row only).

The third button could accept the change, and then set it to colour B.

So you could try it, reject it or accept it. It would need some flag on a rejected row so as to not keep processing that one.

frank_m
04-11-2012, 01:34 AM
Currently it requires several clicks in rows that need several changes, but it does show me all of the results before moving to the next match, which is awesome.

In other words there are occasionally a couple more clicks required to run the routine than what technically should be necessary, but I'm very pleased with the functionality regardless - Thanks again for your generosity.

My statements shown in red above are inacurate. The only changes that would make it better is that right now the 1st click finds a the nerxt match, colors the row and makes some changes, (not all of the changes). The the 2nd click makes the rest of the changes (if any), and a 3rd click moves to the next match, (which gives me a chance to review the changes before moving.)
-- In other words, currently as the code is, the number of clicks required is exactly how I want it;
the only change in functionality that would be nice is for it to not make changes and coloring the row when the code first arrives at the next match.

Edit: added quote below and a reply

Maybe what would be nice would be three buttons.

The first button makes ALL of the changes on the next row and colours the line colour A.

The second button could reverse that change (for the last matched row only).

The third button could accept the change, and then set it to colour B.

So you could try it, reject it or accept it. It would need some flag on a rejected row so as to not keep processing that one.
Yeah that would be good, but not sure that I like having the clutter of three buttons. -- Well, in thinking, that could be solved by using a userform. - When I'm feeling up to it I'll do the work of creating the userform, so that you won't have to kill your time with that. - Thanks :bow: that is some good extra functionality you have thought of.

Edit:
Does my idea below seem any easier to accomplish? Because if it is I think that is all that you should bother with.


-- In other words, currently as the code is, the number of clicks required is exactly how I want it;
the only change in functionality that would be nice is for it to not make changes and coloring the row when the code first arrives at the next match -- A 2nd click would make the changes and color the row, and a 3rd click would move to the next match.
All the other coding you have proposed would be a Cadillac version, but I'm not sure it's worth all the time it might take you.

frank_m
04-11-2012, 02:09 AM
ActiveWindow.ScrollRow = Found.Row could be used so each new match would scroll to the top before coloring it, for ease of spotting it.

Bob Phillips
04-11-2012, 02:25 AM
Isn't it after midnight there? Shouldn't you be stopping :)

frank_m
04-11-2012, 02:30 AM
Isn't it after midnight there? Shouldn't you be stopping :)yeah, 2:30 AM here. I'm going to turn in now. :whistle:

frank_m
04-11-2012, 02:58 PM
Hi again Bob,

I have tweaked this to have the functionality that I spoke of before crashing last night. - Not as many options as your idea has, but avoids putting you through the extra time for that.

I'm very happy with it. - It now selects the entire row for each match (just to make the location obvious), plus scrolls to exactly 10 rows above (so that I can review several rows above and below). - Presents me with a Yes/No msgbox before coloring, or making any changes, - Processes the entire row with a loop if I click Yes, aborts if I click No, but allows me to continue on to the next, if I do skip a row.

It still could surely use your master hand to tidy it up, but if you do choose to be so kind once more, with this project; there is certainly no rush. _ Thanks once more for your time and great work.

Edit: Removed rng variable and used Therow for both needs. - Replaced attachment with Rev2 sample
Edit#2: Dimensioned several variables that I missed.. Added Option Explicit - Replaced attachment with Rev3 sample

Option Explicit

Private Sub CommandButton1_Click()
Dim firstAddress As String
Dim Found As Range
Dim fNext As Boolean, fExit As Boolean
Dim stringToFind
Dim sMSG As String
Dim TheRow As Range
Dim cll As Range

stringToFind = "Void"

Set Found = Cells.Find(What:=stringToFind, _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not Found Is Nothing Then

firstAddress = Found.Address

Do
fNext = Found.Column <> 15 Or (Found.Column = 15 And Left$(Found.Value, 4) <> stringToFind)

If Not fNext Then
Set Found = Cells.FindNext(Found)
fExit = Found Is Nothing Or Found.Address = firstAddress
End If
Loop Until fNext Or fExit

If Not fExit Then

With Found
Found.EntireRow.Activate
ActiveWindow.ScrollRow = .Row - 10

sMSG = MsgBox("One or more instances of the Word " & Chr(34) & "Void" & Chr(34) _
& " were Found in Row: " & Found.Row _
& vbNewLine & vbNewLine & "Click Yes to mark " _
& Chr(34) & "V" & Chr(34) & " in Column(A), and prefix the value in Column(O) with " _
& Chr(34) & "Void" & Chr(34) & ", and erase all other instances." _
& vbNewLine & vbNewLine & "The row will also be highlighted light blue.", _
vbQuestion + vbYesNo, "Permision to process")

If sMSG = vbNo Then
Found.EntireRow.Cells(1).Offset(1, 0).Activate
Exit Sub
End If

Set TheRow = .EntireRow.Cells(1).Resize(, 30)
TheRow.Interior.ColorIndex = 8

End With
If Not TheRow Is Nothing Then
Application.ScreenUpdating = False
For Each cll In TheRow.Cells
With cll

If Not .EntireRow.Cells(1).Value = "V" Then .EntireRow.Cells(1).Value = "V"

If UCase(.Value) = UCase(stringToFind) Then
.ClearContents
End If

.Value = Replace(.Value, " " & stringToFind, "")
.Value = Replace(.Value, stringToFind, "")
.Value = Replace(.Value, " " & LCase(stringToFind), "")
.Value = Replace(.Value, LCase(stringToFind), "")
.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, " " & stringToFind, "", vbTextCompare)
.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, stringToFind, "")
.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, " " & LCase(stringToFind), "", vbTextCompare)
.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, LCase(stringToFind), "")
.EntireRow.Cells(15).Value = stringToFind & .EntireRow.Cells(15).Value
End With
Next cll
End If

Application.ScreenUpdating = True

Else
MsgBox "No Match Found"
End If
End If
End Sub

frank_m
04-11-2012, 04:15 PM
I decided that I do infact need a userform, only because the stupid msbox can't be positioned, so I have to keep manualy moving it out of the way.

How can I make the command: Userform1.Show interup the macro? As to behave in the same way as a msgbox? - Is that possible? or does the entire approach have to be different than what I have now?

-- If the approach that I have now will work with a userform, what commands can I use behind the Yes and No buttons, to continue, or exit?

frank_m
04-11-2012, 06:24 PM
I got the userform put together and it's working well during some limited testing. -- Crossing my fingers - UserFormSample workbook attached

Option Explicit

Private Sub CommandButton1_Click()
'Worksheet Code - Sheet Command Button (Find Void Rows)
Dim firstAddress As String
Dim Found As Range
Dim fNext As Boolean, fExit As Boolean
Dim stringToFind
Dim sMSG As String
Dim TheRow As Range
Dim cll As Range

stringToFind = "Void"

Set Found = Cells.Find(What:=stringToFind, _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not Found Is Nothing Then

firstAddress = Found.Address

Do
fNext = Found.Column <> 15 Or (Found.Column = 15 And Left$(Found.Value, 4) <> stringToFind)

If Not fNext Then
Set Found = Cells.FindNext(Found)
fExit = Found Is Nothing Or Found.Address = firstAddress
End If
Loop Until fNext Or fExit

If Not fExit Then

With Found
Found.EntireRow.Select
ActiveWindow.ScrollRow = .Row - 10


sMSG = "One or more instances of the Word " & Chr(34) & "Void" & Chr(34) _
& " were Found in Row: " & Found.Row _
& vbNewLine & vbNewLine & "Click Yes to mark " _
& Chr(34) & "V" & Chr(34) & " in Column(A), and prefix the value in Column(O) with " _
& Chr(34) & "Void" & Chr(34) & ", and erase all other instances." _
& vbNewLine & vbNewLine & "The row will also be highlighted light blue."
With UserForm1
.Label1 = sMSG
.Show
End With
If BoolNext = False Then ' Flag set with Userform yes/No buttons
Found.EntireRow.Cells(1).Offset(1, 0).Activate
GoTo wsExit
End If

Set TheRow = .EntireRow.Cells(1).Resize(, 30)
TheRow.Interior.ColorIndex = 8

End With
If Not TheRow Is Nothing Then
Application.ScreenUpdating = False
For Each cll In TheRow.Cells
With cll

If Not .EntireRow.Cells(1).Value = "V" Then .EntireRow.Cells(1).Value = "V"

If UCase(.Value) = UCase(stringToFind) Then
.ClearContents
End If

.Value = Replace(.Value, " " & stringToFind, "")
.Value = Replace(.Value, stringToFind, "")
.Value = Replace(.Value, " " & LCase(stringToFind), "")
.Value = Replace(.Value, LCase(stringToFind), "")
.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, " " & stringToFind, "", vbTextCompare)
.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, stringToFind, "")
.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, " " & LCase(stringToFind), "", vbTextCompare)
.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, LCase(stringToFind), "")
.EntireRow.Cells(15).Value = stringToFind & .EntireRow.Cells(15).Value
End With
Next cll

End If

Else
MsgBox "No Match Found"
End If
End If
wsExit:
Application.ScreenUpdating = True
End Sub


Private Sub CommandButton2_Click()
'WorkSheet Code - Command Button - Reset Test Data
Application.ScreenUpdating = False
Sheets("Looks like this Before Process").Cells.Copy Sheets("Sheet To Process").Cells
ActiveWindow.ScrollRow = 16
Range("D15").Select
Application.ScreenUpdating = True

End Sub


UserForm Code

Private Sub CommandButton2_Click()
'Yes Button
Unload Me
BoolNext = True

End Sub


Private Sub CommandButton3_Click()
'No Button
Unload Me
BoolNext = False

End Sub


Private Sub UserForm_Activate()

With Me
.Top = Application.Top
.Left = Application.Left + 25
End With
Application.ScreenUpdating = True

End Sub


Private Sub UserForm_Deactivate()

Application.ScreenUpdating = True

End Sub



Option Explicit
'At the top of a Regular Module
Public BoolNext As Boolean

Bob Phillips
04-12-2012, 01:21 AM
Frank, how about having three buttons.

Yes highlights the row and continues to the next.

No does not highlight nor changes the row, but moves on to the next.

Quit abandons the search and closes the form.

This might improve the workflow.

frank_m
04-12-2012, 01:38 AM
Frank, how about having three buttons.

Yes highlights the row and continues to the next.

No does not highlight nor changes the row, but moves on to the next.

Quit abandons the search and closes the form.

This might improve the workflow.
Hi Bob,

Yes that would be far better. - I tried to code it that way, but I totaly fried my brain with failure, as the only way I could come up with to stop the code execution at the proper time was by executing the Find procedure from the sheet button, and showing the Form. - Then hiding it with the Yes/No buttons, , then repeating that for each row :doh: :whip :bug: (more tedious than necessary for sure)

Bob Phillips
04-12-2012, 01:46 AM
I'll take a crack at it later today.

frank_m
04-12-2012, 01:51 AM
I'll take a crack at it later today.
Thank you sir - Time for me to plop myself down in my hay loft.

frank_m
04-13-2012, 12:35 AM
HI again Xld

I felt bad having you re-write this for me, so I spent most of the day and got it working. - Hope I got it before you chewed up more of your time.
-- It has a couple extra tasks that it does now such as can find a colored row, as I want to examine all of those and rows that have the letter "V" in Column(A), whether or not the word "Void" is within that row. - Plus the regular functions that you wrote, except I split those into two separate operations.. The 1st Button to Find rows conatining the word "Void", the 2nd button to Process any selected row. (All buttons in the Form)

As always I'm sure what I came up with has some flaws, but it seems to work during limited testing.

Thanks a million for all of your help and your great ideas :bow:

Option Explicit

Private Sub CommandButton1_Click()
'Reset Test Data (Sheet Command Button)
Application.ScreenUpdating = False
Sheets("Looks like this Before Process").Cells.Copy Sheets("Sheet To Process").Cells
ActiveWindow.ScrollRow = 16
Range("D15").Select
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton4_Click()
'Show Form (Sheet Button)
If ActiveCell.Row < 16 Then
'Either the Column(A) cell or the Entire row must be selected in code before opening the form,
'as to avoid a type mismatch error when searching Col(A) for the letter "V"
Rows("16:16").Select
Else
ActiveCell.EntireRow.Select
End If
UserForm1.Show
End Sub

User Form Code

Option Explicit
Private Sub CommandButton2_Click()
' Process Active Row (Button on Form)
' Written by Xld here at Vbax (Very Slightly modified)
Dim cll As Range, TheRow As Range
Dim stringToFind As String
stringToFind = "Void"

With ActiveCell
Set TheRow = ActiveCell.EntireRow.Cells(1).Resize(, 30)
TheRow.Interior.ColorIndex = 8

If Not TheRow Is Nothing Then
Application.ScreenUpdating = False
For Each cll In TheRow.Cells
With cll

If Not .EntireRow.Cells(1).Value = "V" Then .EntireRow.Cells(1).Value = "V"

If UCase(.Value) = UCase(stringToFind) Then
.ClearContents
End If

.Value = Replace(.Value, " " & stringToFind, "")
.Value = Replace(.Value, stringToFind, "")
.Value = Replace(.Value, " " & LCase(stringToFind), "")
.Value = Replace(.Value, LCase(stringToFind), "")
.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, " " & stringToFind, "", vbTextCompare)
.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, stringToFind, "")
.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, " " & LCase(stringToFind), "", vbTextCompare)
.EntireRow.Cells(15).Value = Replace(.EntireRow.Cells(15).Value, LCase(stringToFind), "")
.EntireRow.Cells(15).Value = stringToFind & .EntireRow.Cells(15).Value
End With
Next cll
End If
End With
Application.ScreenUpdating = True
End Sub


Private Sub CommandButton3_Click()
'Find Next Colored Row (Button on Form)
Dim i As Long
Dim LastRow As Long
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "G").End(xlUp).Row

Do While ActiveCell.Interior.ColorIndex <> xlNone

ActiveCell.Offset(1, 0).Select

Loop

For i = ActiveCell.Row To LastRow

If Cells(i, 7).Interior.ColorIndex <> xlNone Then
Cells(i, 7).EntireRow.Select
Exit For
End If

Next i

End Sub


Private Sub CommandButton4_Click()
'Look for next row containig the word "Void" (Button on Form)
' Written by Xld here at Vbax (Very Slightly modified)
Dim firstAddress As String
Dim Found As Range
Dim fNext As Boolean, fExit As Boolean
Dim stringToFind

stringToFind = "Void"
Set Found = Cells.Find(What:=stringToFind, _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not Found Is Nothing Then
' match was found
firstAddress = Found.Address

Do
fNext = Found.Column <> 15 Or (Found.Column = 15 And Left$(Found.Value, 1) <> stringToFind)

If Not fNext Then
Set Found = Cells.FindNext(Found)
fExit = Found Is Nothing Or Found.Address = firstAddress
End If
Loop Until fNext Or fExit

If Not fExit Then
Set Found = Cells.FindNext(Found)

Found.EntireRow.Select
End If

Else
MsgBox "No Match Found"

End If

End Sub


Private Sub CommandButton5_Click()
'I modified to my needs a routine googled and found at the Excelform (written by Leith Ross)
' Search Col(A) for the letter "V"
Dim firstAddress As String
Dim Found As Range
Dim Rng As Range
Dim SearchRng As Range
Dim SO As Long
Dim RA As Range
Set SearchRng = (Columns(1))

For Each RA In SearchRng.Areas
SO = SO + 2 '1 = by rows, 2 by columns
Set Rng = RA.Cells
Set Found = Rng.Find(What:="V", _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=SO, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Found Is Nothing Then
firstAddress = Found.Address
Do
Set Found = Rng.FindNext(Found)
Found.Activate

Loop While Not Found Is Nothing And Found.Address <> firstAddress
End If
Next RA
End Sub
Private Sub CommandButton6_Click()
'Exit Button
Unload Me
End Sub


Private Sub UserForm_Activate()
With Me
.Caption = "Tool For Locating Void and / or Voided Records"
.Top = Application.Top
.Left = Application.Left + 25
End With
Application.ScreenUpdating = True
End Sub


Private Sub UserForm_Deactivate()
Application.ScreenUpdating = True
End Sub

Sample workbook attached

frank_m
04-13-2012, 01:44 AM
Tidied up (removed unused variables) and made the userform and buttons all white, so its in my opinion more friendly to the users eyes.

Rev2 sample workbook attached