PDA

View Full Version : Improuvement af this macros



teodormircea
05-14-2008, 05:11 AM
I have an macros that find the cells that contains some given wild chars and then color them.
I want also to add a code that will display in a text box the wild chars found


Sub Mark_char_AD()
Dim c As Range
Dim X As Variant
Dim caractere As Variant
Dim i, j As Byte
'Dim lastrow As Long
Worksheets("CharAD").Activate
'Define array of special chars
caractere = Array("&", "*", ",", ".", "@", "$", "#", "?", _
":", "'", "!", ";", ")", "(", "[", "]", " - ", "-", "_", "+", " ", " ", "``")

'Ask for column (Enter the number not the letter)
X = CLng(InputBox(Prompt:="What column to MARK"))

'#If column number isn't valid then quit
If (X < 1) + (X > Columns.Count) Then Exit Sub


For Each c In Range(Cells(1, X), Cells(Rows.Count, X).End(xlUp))

'Set colour index to no colour
c.Interior.ColorIndex = -4142

For i = 1 To Len(c)

For j = 0 To UBound(caractere)


'if special char found then set colour to purple
If Mid(c, i, 1) = caractere(j) Then
c.Interior.ColorIndex = 7
End If
Next j
Next i
Next c

End Sub
Thanks guys :*)

stanleydgrom
05-16-2008, 05:43 PM
teodormircea,

I am not sure about the "textbox" - see in the code the following areas:
'****************************************



Sub Mark_char_AD()
Dim c As Range
Dim X As Variant
Dim caractere As Variant
Dim i, j As Byte
'Dim lastrow As Long
Dim strFoundChars As String
strFoundChars = ""
Worksheets("CharAD").Activate
'Define array of special chars
caractere = Array("&", "*", ",", ".", "@", "$", "#", "?", _
":", "'", "!", ";", ")", "(", "[", "]", " - ", "-", "_", "+", " ", " ", "``")

'Ask for column (Enter the number not the letter)
X = CLng(InputBox(Prompt:="What column to MARK"))

'#If column number isn't valid then quit
If (X < 1) + (X > Columns.Count) Then Exit Sub

For Each c In Range(Cells(1, X), Cells(Rows.Count, X).End(xlUp))
'Set colour index to no colour
c.Interior.ColorIndex = -4142
For i = 1 To Len(c)
For j = 0 To UBound(caractere)
'if special char found then set colour to purple
If Mid(c, i, 1) = caractere(j) Then
c.Interior.ColorIndex = 7

'****************************************
'Add the found characters to the variable
strFoundChars = strFoundChars & Mid(c, i, 1)
'****************************************

End If
Next j
Next i
Next c

'****************************************
'Display the characters that were found.
MsgBox "strFoundChars = " & strFoundChars

'Or, use a blank area of your worksheet to send the "strFoundChrs" to'
'Range("AA1") = strFoundChrs
'****************************************

End Sub




Have a great day,
Stan