Code like this will do the job.
You could make it a lot shorter and simpler, but this will cover all,
plus
there is some general purpose code in there
to speed up a Replace.
Function MakeValidSheetName(strSheetName As String) As String
Dim i As Long
Dim strSheetOld As String
'take out invalid characters
'---------------------------
MakeValidSheetName = ClearCharsFromString(strSheetName, "*:?/\[]")
'truncate if sheet name is too long, can be 31, but allow for added
trailers
'---------------------------------------------------------------------------
MakeValidSheetName = Left$(MakeValidSheetName, 27)
strSheetOld = MakeValidSheetName
'Avoid existing sheets
'---------------------
i = 1
Do While SheetExists(MakeValidSheetName)
i = i + 1
MakeValidSheetName = strSheetOld & "_" & i
Loop
End Function
Function ClearCharsFromString(ByVal strString As String, _
ByVal strChars As String, _
Optional ByVal bAll As Boolean = True, _
Optional ByVal bLeading As Boolean, _
Optional ByVal bTrailing As Boolean) As
String
Dim i As Long
If Len(strString) = 0 Then
ClearCharsFromString = strString
Exit Function
End If
If bAll Then
For i = 1 To Len(strChars)
strString = ReplaceX(strString, _
Mid$(strChars, i, 1), _
vbNullString)
Next i
Else
If bLeading Then
Do While InStr(1, strChars, Left$(strString, 1), _
vbBinaryCompare) > 0
strString = Right$(strString, _
Len(strString) - 1)
Loop
End If
If bTrailing Then
Do While InStr(1, strChars, Right$(strString, 1), _
vbBinaryCompare) > 0
strString = Left$(strString, _
Len(strString) - 1)
Loop
End If
End If
ClearCharsFromString = strString
End Function
Private Function ReplaceX(ByVal strSource As String, _
ByVal strFind As String, _
ByVal strReplace As String, _
Optional ByVal lStart As Long = 1, _
Optional ByVal lCount As Long = -1, _
Optional ByVal bCompare As VbCompareMethod =
vbBinaryCompare) As String
'could make this a bit faster by making it a Sub and putting the result
in
a ByRef argument
'------------------------------------------------------------------------------------------
Dim i As Long
Dim lPos As Long
Dim lLenFind As Long
lPos = InStr(lStart, strSource, strFind, bCompare)
If lPos = 0 Then
'strFind is not in strSource, so return strSource and get out
'------------------------------------------------------------
If lStart = 1 Then
ReplaceX = strSource
Else
'to make it consistent with the normal Replace function
'------------------------------------------------------
ReplaceX = Mid$(strSource, lStart)
End If
Exit Function
End If
lLenFind = Len(strFind)
If lStart < lPos And lLenFind = Len(strReplace) Then
If lCount = 1 Then
Mid$(strSource, lPos) = strReplace
Else
Do While lPos > 0
Mid$(strSource, lPos, lLenFind) = strReplace
lPos = InStr(lPos + lLenFind, strSource, strFind, bCompare)
Loop
End If
If lStart = 1 Then
ReplaceX = strSource
Else
'to make it consistent with the normal Replace function
'------------------------------------------------------
ReplaceX = Mid$(strSource, lStart)
End If
Else
ReplaceX = Replace(strSource, strFind, strReplace, lStart, lCount,
bCompare)
End If
End Function
Function SheetExists(ByVal strSheetName As String) As Boolean
'returns True if the sheet exists in the active workbook
'-------------------------------------------------------
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(strSheetName)
If Err = 0 Then
SheetExists = True
End If
End Function
RBS
pickytweety said:
With wksNew
ActiveSheet.PageSetup.PrintArea = r.Address
.Name = Left(Trim(currCat), 31) 'this line is
where I
need to expand
ActiveSheet.Calculate
.Cells.Copy
.Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
application.CutCopyMode = False
End With
When the above code is running, occasionally the macro will get stuck
because the currCat name contains a character, such as a slash, that
Excel
cannot use in a sheet name. Can someone tell me how to write code that
will
either strip out invalid sheet name characters or replace them with
something
like a dash?
