Never knew that and thanks for the tip.
Will add that to the code.
Do you know why it doesn't allow a sheet being called history?

RBS



"Jim Thomlinson" wrote in message
...
Very nice. I will be keeping a copy of this for future reference. One
thing I
see missing is that it does not validate that you are trying to rename the
sheet to "history". XL will not let you name a sheet history.
--
HTH...

Jim Thomlinson


"RB Smissaert" wrote:

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" wrote in message
...
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?
--
Thanks,
PTweety