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

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" <(E-Mail Removed)> wrote in message
news:351DA333-769B-4DFF-AE6E-(E-Mail Removed)...
> 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

I don't think you'll ever be able to validate all the names that can't be used
(duplicate names could be legal, but they won't be valid).

I'd just try to the rename and look out for an error

dim wks as worksheet
dim newname as string
set wks = worksheets.add
newname = "some string here"

on error resume next
wks.name = newname
if err.number <> 0 then
'failed
err.clear
msgbox "Rename failed"
end if
on error goto 0

Try renaming a worksheet to History (just for fun!).

pickytweety wrote:
>
> 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

--

Dave Peterson

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" <(E-Mail Removed)> wrote in message
> news:351DA333-769B-4DFF-AE6E-(E-Mail Removed)...
> > 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
>
>

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" <James_Thomlinson@owfg-Re-Move-This-.com> wrote in message
news:586DC904-F2A5-419D-8A5B-(E-Mail Removed)...
> 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" <(E-Mail Removed)> wrote in message
>> news:351DA333-769B-4DFF-AE6E-(E-Mail Removed)...
>> > 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
>>
>>

OK, I can see now it is a reserved name.

RBS


"RB Smissaert" <(E-Mail Removed)> wrote in message
news:%(E-Mail Removed)...
> 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" <James_Thomlinson@owfg-Re-Move-This-.com> wrote in
> message news:586DC904-F2A5-419D-8A5B-(E-Mail Removed)...
>> 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" <(E-Mail Removed)> wrote in message
>>> news:351DA333-769B-4DFF-AE6E-(E-Mail Removed)...
>>> > 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
>>>
>>>
>

A fun read...

http://spreadsheetpage.com/index.php/oddities/
--
HTH...

Jim Thomlinson


"RB Smissaert" wrote:

> 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" <James_Thomlinson@owfg-Re-Move-This-.com> wrote in message
> news:586DC904-F2A5-419D-8A5B-(E-Mail Removed)...
> > 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" <(E-Mail Removed)> wrote in message
> >> news:351DA333-769B-4DFF-AE6E-(E-Mail Removed)...
> >> > 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
> >>
> >>
>
>