Find a list of special characters and copy the entire row where th

[Guest]

I am trying to clean up some data and I need to search about 20 tables (which
I have copied down to spreadsheets) and Identify the lines that contain one
or more of these special characters.

I have not been able to put all the components together in working fashion.

I plan on just doing them one at a time. I have been using a SUB() for just
the active sheet and running it on each sheet individually. This would be
just fine if it worked.

thanks for any help.

 

[Bernie Deitrick]

Michael,

If your sub is called MichaelsSub, then

Sub AllSheets()
Dim mySht As Worksheet
For Each mySht In ActiveWorkbook.Worksheets
mySht.Activate
Call MichaelsSub
Next mySht
End Sub

As long as your sub works on the activesheet, and is written well, that will
work. Post your code if things are otherwise.

HTH,
Bernie
MS Excel MVP

 

[Guest]

Thanks Bernie,

But the problem is my code doesn't work at all. I am a complete novice and
basically record macro and then try and adjust the resulting code to get my
results.

Basicall what I have is a work book with two sheets. (data,results) The
"resluts" sheet starts off blank.

I want to search sheet "data" for the following special characters:

' (single quote)
" (double quote)
, (comma)
* (asterisk)
`(apostrophe)
|(pipe)
^(carrot)
? (question mark)
<(less than)

(greater than)

\ (escape or backslash)
$ (dollar sign)

For each found match I would like to highlight the character and copy the
entire row that it was found on to sheet "results". The highlight part is
not imperative it will just make it easier to identify when we use the list
to clean up our data.

I also chose to copy the entire row because I thought it would be easier, I
really just need the value of column 1 and the column header from the cell
the character was found in.

As always I humbly appreciate all the help from this newsgroup.

 

[Guest]

I have tried to adapt some code I have found but I have been unable to get it
to work. Here is the code I am trying. Since I don't know how to use an
array of charaters for a variable I chose to search for ","(commas).

Sub findspecial()
Dim Rng As Range, Rng1 As Range
Application.Worksheets("data").Select
Set Rng = Range("A2:T1833").Find(What:="Tom", LookAt:=xlWhole,
LookIn:=xlValues)
If Rng Is Nothing Then
MsgBox "Data Not Found"
Exit Sub
Else
Set Rng1 = Rng
Do While Rng1.Offset(1, 0).Value = 31
Set Rng1 = Rng1.Offset(1, 0)
Loop
Range(Rng, Rng1).Offset(0, 1).Copy _
Destination:=Application.Worksheets("Results").Range("A2")
End If

End Sub

It either just posts 1 result or it is overwriting the copied results.

 

[Guest]

Ok, one step forward two steps back. Once I understood what the previous
script was doing I realized where I needed to make changes. I now have
broken at least as much as I fixed.

Please help if you can. Here is the latest bowl of crap I have created.


Sub findspecial()
Dim Rng As Range, cell1 As Range
Application.Worksheets("data").Select
Set Rng = Range("Data").Find(What:=",", lookat:=xlPart, LookIn:=xlValues)
Set cell1 = Application.Worksheets("Results").Range("A2")
If Rng Is Nothing Then
MsgBox "Data Not Found"
Exit Sub
Else

Do While Not Rng = ""
ActiveCell.EntireRow.Copy _
Destination:=Application.Worksheets("Results").Range.Cells(cell1)
Set cell1 = cell1.Offset(1, 0)

Loop

End If

End Sub

 

[Dave Peterson]

Maybe:

Option Explicit
'
'' (single quote)
'" (double quote)
', (comma)
'* (asterisk)
'`(apostrophe)
'|(pipe)
'^(carrot)
'? (question mark)
'<(less than)
'>(greater than)
'\ (escape or backslash)
'$ (dollar sign)

Sub testme02()

Application.ScreenUpdating = False

Dim myChars As Variant
Dim iCtr As Long
Dim wks As Worksheet
Dim newWks As Worksheet
Dim oRow As Long
Dim oCol As Long
Dim FoundCell As Range
Dim FirstAddress As String

myChars = Array("'", """", ",", "~*", "`", "|", "^", _
"~?", "<", ">", "\", "$")

'notice the ~*, ~?. You'll need it for ~~, too.

Set newWks = Worksheets.Add
newWks.Range("a1").Resize(1, 4).Value = _
Array("SheetName", "Address", "Header", "Value")

oRow = 2
oCol = 1
For Each wks In ActiveWorkbook.Worksheets
With wks
If .Name = newWks.Name Then
'do nothing
Else
With .UsedRange
For iCtr = LBound(myChars) To UBound(myChars)
Application.StatusBar = "Processing: " _
& .Parent.Name & " char: " _
& Right(myChars(iCtr), 1)
Set FoundCell = .Find(What:=myChars(iCtr), _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
Lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
'not found on the sheet
Else
FirstAddress = FoundCell.Address
Do
newWks.Cells(oRow, oCol).Value _
= "'" & .Parent.Name
newWks.Cells(oRow, oCol + 1).Value _
= FoundCell.Address(0, 0)
newWks.Cells(oRow, oCol + 2).Value _
= "'" & .Parent.Cells(1, _
FoundCell.Column).Text
newWks.Cells(oRow, oCol + 3).Value _
= "'" & FoundCell.Text
oRow = oRow + 1
If oRow > .Parent.Rows.Count Then
oCol = oCol + 4
End If
Set FoundCell = .FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address <> FirstAddress
End If
Next iCtr
End With
End If
End With
Next wks

newWks.UsedRange.Columns.AutoFit

With Application
.ScreenUpdating = True
.StatusBar = False
End With

End Sub

 

[Guest]

Dave,

Thank you so much for your work.

I am trying to make one adjustment.

Instead of the cell address I need to value of the adjacent cell in column A.

This column will always have record specific information such as customer
number / item number / order number etc.

Since you are using foundcell info to return your results I am having a bit
of difficulty figuring out how to return that particular value.

This was absolutely awesome and the code works perfectly.

Thanks Dave for the excellent script you provided.

 

[Tom Ogilvy]

Change
newWks.Cells(oRow, oCol + 1).Value _
= FoundCell.Address(0, 0)

to
newWks.Cells(oRow, oCol + 1).Value _
= "'" & .Parent.Cells(FoundCell.Row,
_
1).Text

 

[Guest]

Thanks Tom that changed worked nicely for me. I believe I am understanding a
little bit more each day.

Let me just say this Forum has been a life saver for me and I greatly
appreciate every bit of help I have received from you guys.

Michael