Code for avoiding slashes, ampersands, etc. when naming sheets
 

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 for avoiding slashes, ampersands, etc. when naming sheets
 

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

Code for avoiding slashes, ampersands, etc. when naming sheets
 

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

Code for avoiding slashes, ampersands, etc. when naming sheets
 

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

Code for avoiding slashes, ampersands, etc. when naming sheets
 

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

Code for avoiding slashes, ampersands, etc. when naming sheets
 

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

RBS


"RB Smissaert" wrote in message
...
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

Code for avoiding slashes, ampersands, etc. when naming sheets
 

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" 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