Renamed invalid sheet name
Here is a shorter function that does the same thing your AlphaNumOnly
function does...
Function AlphaNumOnly(ByVal ConStr As String) As String
Dim x As Long
For x = 1 To Len(ConStr)
If Mid(ConStr, x, 1) Like "[!0-9A-Za-z]" Then Mid(ConStr, x, 1) = " "
Next
AlphaNumOnly = Replace(WorksheetFunction.Trim(ConStr), " ", "_")
End Function
--
Rick (MVP - Excel)
"XLjedi" wrote in message
...
I wrote a short VBA function to rename invalid worksheet names. Basically,
it converts every character that is not Alpha-Numeric-Underscore to
Underscore.
This is the code for the AlphaNumOnly formula that converts a string:
Function AlphaNumOnly(ByVal ConString As String) As String
Dim i As Integer
Dim x As Integer, n As String
Dim last As String
For i = 1 To Len(ConString)
x = Asc(Mid(ConString, i, 1))
Select Case x
Case 32 'space
If last < "" Then
n = n & "_"
last = ""
End If
Case 38 '&
If last < "" Then
n = n & "_"
last = ""
End If
Case 48 To 57 'numeric
n = n & Chr(x)
last = Chr(x)
Case 65 To 90 'uppercase
n = n & Chr(x)
last = Chr(x)
Case 95 'underscore
If last < "" Then
n = n & Chr(x)
last = ""
End If
Case 97 To 122 'lowercase
n = n & Chr(x)
last = Chr(x)
Case Else
If last < "" Then
n = n & "_"
last = ""
End If
End Select
Next i
AlphaNumOnly = n
End Function
...and you can use the function to convert every tabname in a workbook
like
this:
Sub ATB_AlphaNumSheetName()
Dim Sheet As Worksheet
Dim n As String
On Error GoTo errhand
For Each Sheet In ActiveWorkbook.Sheets
n = AlphaNumOnly(Sheet.Name)
Sheet.Name = n
Next Sheet
Exit Sub
errhand:
Select Case Err.Number
Case 1004
Err.Clear
n = n & "_"
Resume
Case Else
MsgBox "Err: " & Err.Number & vbCrLf & Err.Description,
vbExclamation, "Error"
Stop
Resume
End Select
End Sub
|