VBA to trim cell values for sheet name

WildBurrow

New Member
Joined
Apr 5, 2021
Messages
41
Office Version
  1. 365
Platform
  1. Windows
I'm stepping off the porch to play with the big dogs; I'm posting my first question and providing a sample of my code.

I am using input message boxes to obtain info that will 1) populate cells on the worksheet, and 2) be used in the naming structure for the worksheet. The issue is that I'd like to further tweak how the data is trimmed. There are four cells that are used in the sheet name:

Cell LabelParametersCell Maximum Characters
Cell Format
Site Visit DateAlways used8mm.dd.yy
Address NumberAlways used , may have less than 5 characters5alpha-numeric
Street NameAlways used, may have less than 19 characters19alpha-numeric
Unit NumberInfrequently used but needed is applicable5alpha-numeric

Currently, I have code that will trim the data to 1) accommodate their maximum character lengths and 2) conform to the 31 character limit for worksheet naming structure (code below).
VBA Code:
ShNmExt = Trim(Left(RAddNo, 5) & "_" & Left(RStreetNm, 11) & "_" & Left(RUnit, 4))

So for instance:
I have a site visit date of 9/23/21 and the address was 12345 Birkshire Wilmont, Unit 1234.
My sheet name would be:
12345_BirkshireWi_1234_09.23.21

Unfortunately, if an address number only has 2 characters (e.g. house number 22), and no unit number, I'm not utilizing my full 31 character limit and I can't shift those empty spaces to street name, which would be ideal.
Same site visit date but the address is 22 Birkshire Wilmont with no unit number
My sheet name would be:
22_BirkshireWil_09.23.21

Is there a way to trim to a maximum number of characters for each cell but then allow any "extra" spaces to be used for the street name?

My full code is below (hot mess alert!)


VBA Code:
Private Sub CommandButton10_Click()
'Create Special Investigation Report
Dim iWindowState As Integer

With Application
.ScreenUpdating = False
.DisplayAlerts = False
iWindowState = .WindowState
End With

'Site Visit Information
Dim NewName As String, NewDate As String, msg As String, Ans As Long, NewSite As String, AddNo As String, StreetNm As String, Unit As String, RAddNo As String, RStreetNm As String, RUnit As String, ShNmExt As String

'Enter Date for name of sheet (NewDate)
NewDate = InputBox("Enter Site Visit Date" _
& vbNewLine & vbNewLine & "Use forward slash in date: mm/dd/yy", "Date Entry", "mm/dd/yy")

'Set format for Site Visit Date (NewSite)
NewSite = Format(NewDate, "mm/dd/yy"

'If nothing entered into Date Input Box, exit sub
If NewDate = "" Then Exit Sub

'Enter Address Number for name of sheet (Add)

AddNo = InputBox(" " & vbNewLine & vbNewLine & "Enter Address Number", "Affected Party Address Number", 0)
If AddNo = "" Then Exit Sub

'Enter Street Name for name of sheet (StreetNm)
StreetNm = InputBox("Enter Street Name Only - No Suffixes" & vbNewLine & vbNewLine & "NOTE: For State Routes, County or Township Roads/Highways enter jurisdictional level and the numeric designator (e.g. County 122)." _
& vbNewLine & vbNewLine & " - Do not add the suffix (e.g. Route, Road, Highway)" & vbNewLine, "Affected Party Street Name", "County 122")
If StreetNm = "" Then Exit Sub

'Enter Unit Number for name of sheet (Unit)
Unit = InputBox(" " & vbNewLine & vbNewLine & "Enter Unit Number, if applicable", "Affected Party Unit Number")

'Rename Worksheet
'If date then format name using decimal point (not slashes) - if not a date, the provide error message and exit sub
If IsDate(NewDate) Then
NewName = Format(CDate(NewDate), "mm.dd.yy")
Else
MsgBox "Please enter a valid date format"
Exit Sub
End If

'If sheet exists provide error message
If SheetExists(NewName) Then
msg = "A sheet with the name " & NewName & " aleady exists."
Ans = MsgBox(msg, vbOK)
Exit Sub
End If

'Copy Master
Sheets("Master").Copy after:=Sheets("Dashboard")

'Trims cell values used in new sheet name (ShNmExt)

RAddNo = Replace(AddNo, " ", "")
RStreetNm = Replace(StreetNm, " ", "")
RUnit = Replace(Unit, " ", "")

ShNmExt = Trim(Left(RAddNo, 5) & "_" & Left(RStreetNm, 11) & "_" & Left(RUnit, 4))

'Activate / Active Sheet
'Provide Name for New Sheet
ActiveSheet.name = ShNmExt & "_" & NewName

'Populate report data
.Range("U25").value = NewDate
.Range("AA51").value = "Select..."
.Range("B72").value = "Weather at time of Site Visit"
.Range("B127").value = "Site Description"
.Range("N127").value = ""

'Populate fields used in Sheet Name
.Range("Q51").value = AddNo
.Range("U51").value = StreetNm
.Range("AC51").value = Unit

ActiveSheet.Protect ("Fieldops"), UserInterFaceOnly:=True

With Application
.ScreenUpdating = True
.DisplayAlerts = True
.WindowState = iWindowState
End With

End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
@WildBurrow
Maybe with this .......

VBA Code:
'Copy Master
Sheets("Master").Copy after:=Sheets("Dashboard")

'Trims cell values used in new sheet name (ShNmExt)


Dim NoLen As Integer, ULen As Integer, StreetLen As Integer
'get number string and length

RAddNo = Replace(AddNo, " ", "")
NoLen = WorksheetFunction.Min(5, Len(RAddNo))
RAddNo = Left(RAddNo, NoLen)
'get unit string and length if unit exists
RUnit = Replace(Unit, " ", "")
ULen = WorksheetFunction.Min(5, Len(RUnit))
If ULen > 0 Then
    RUnit = "_" & Left(RUnit, ULen)
    ULen = ULen + 1
End If
'get Street string at max length available or input
RStreetNm = Replace(Replace(StreetNm, " ", ""), ",", "")
StreetLen = WorksheetFunction.Min(Len(RStreetNm), 21 - NoLen - ULen)
RStreetNm = Left(RStreetNm, StreetLen)

ShNmExt = Trim(Left(RAddNo, 5) & "_" & Left(RStreetNm, 11) & "_" & Left(RUnit, 4))

'Activate / Active Sheet
'Provide Name for New Sheet
ActiveSheet.Name = ShNmExt & "_" & NewName

'Populate report data

Hope that helps.
 
Upvote 0
@WildBurrow
Maybe with this .......

VBA Code:
'Copy Master
Sheets("Master").Copy after:=Sheets("Dashboard")

'Trims cell values used in new sheet name (ShNmExt)


Dim NoLen As Integer, ULen As Integer, StreetLen As Integer
'get number string and length

RAddNo = Replace(AddNo, " ", "")
NoLen = WorksheetFunction.Min(5, Len(RAddNo))
RAddNo = Left(RAddNo, NoLen)
'get unit string and length if unit exists
RUnit = Replace(Unit, " ", "")
ULen = WorksheetFunction.Min(5, Len(RUnit))
If ULen > 0 Then
    RUnit = "_" & Left(RUnit, ULen)
    ULen = ULen + 1
End If
'get Street string at max length available or input
RStreetNm = Replace(Replace(StreetNm, " ", ""), ",", "")
StreetLen = WorksheetFunction.Min(Len(RStreetNm), 21 - NoLen - ULen)
RStreetNm = Left(RStreetNm, StreetLen)

ShNmExt = Trim(Left(RAddNo, 5) & "_" & Left(RStreetNm, 11) & "_" & Left(RUnit, 4))

'Activate / Active Sheet
'Provide Name for New Sheet
ActiveSheet.Name = ShNmExt & "_" & NewName

'Populate report data

Hope that helps.
Snakehips,

Thanks so very much for the quick suggestion. I popped the code in the macro and saw no difference. However, isn't the following line still limiting the street name to only 11 characters?

VBA Code:
ShNmExt = Trim(Left(RAddNo, 5) & "_" & Left(RStreetNm, 11) & "_" & Left(RUnit, 4))
 
Upvote 0
@WildBurrow

Apologies. I forgot to include the revised statement for ShNmExt

Here is...

VBA Code:
'Trims cell values used in new sheet name (ShNmExt)

Dim NoLen As Integer, ULen As Integer, StreetLen As Integer
'get number string and length

RAddNo = Replace(AddNo, " ", "")
NoLen = WorksheetFunction.Min(5, Len(RAddNo))
RAddNo = Left(RAddNo, NoLen)
'get unit string and length if unit exists
RUnit = Replace(Unit, " ", "")
ULen = WorksheetFunction.Min(5, Len(RUnit))
If ULen > 0 Then
    RUnit = "_" & Left(RUnit, ULen)
    ULen = ULen + 1
End If
'get Street string at max length available or input
RStreetNm = Replace(Replace(StreetNm, " ", ""), ",", "")
StreetLen = WorksheetFunction.Min(Len(RStreetNm), 21 - NoLen - ULen)
RStreetNm = Left(RStreetNm, StreetLen)

'ShNmExt  now as below.
ShNmExt = Trim(RAddNo) & "_" & RStreetNm & RUnit     '<<<<***********
 
Upvote 0
Solution
? You da man!

It worked beautifully! The sections "get string unit and length if unit exists" and "get street string at max length available or input" is WAY above my coding capacity.

Thank you so very much. I
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,103
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top