Cell Formatting

sassriverrat

Well-known Member
Good Morning,

I need to format a few different cells in the following manners:

A1 has to always add a colon ) after whatever is typed in by a user. Example- "F" in a cell becomes "F:"

A2 has to always be three digits- so if a user puts in "1", the cell shows "001" or if a user puts in "20" it shows as "020" and obviously a three digit number like "340" just stays "340".

A3 has to add an "'ly" to all single letter input codes. So a user might put in W 3, W-3, or W3 and I want it to show as "W'ly 3". However, sometimes the user might use NW 3, NW3, or NW3 and those should just format as "NW 3". So in conclusion, anytime a single letter (and number) are used, the letter should have "'ly" added to it and one space between the "'ly" and the number. And anytime two letters are used, they should just ensure there is a space between the two letter code and the number.

Thanks!

Paul Ked

Active Member
In the Worksheet code module:

Code:
``````Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim a3 As String
If Right([a1], 1) <> ":" Then [a1] = [a1] & ":"
End If
Range("A2").NumberFormat = "@"
If Len([a2]) = 1 Then [a2] = "00" & [a2]
If Len([a2]) = 2 Then [a2] = "0" & [a2]
End If
a3 = Range("A3")
If Mid(a3, 2, 1) Like "[a-zA-Z]" Then
a3 = Left(a3, 2) & " " & Right(a3, 1)
Range("A3") = a3
Else
a3 = Left(a3, 1) & "'ly " & Right(a3, 1)
Range("A3") = a3
End If
End If
Application.EnableEvents = True
End Sub``````

Last edited:

Paul Ked

Active Member
If you want to force uppercase in A1 and A3 (excluding the 'ly) then:

Code:
``````Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim a3 As String
If Right([a1], 1) <> ":" Then [a1] = [COLOR=#ff0000]UCase([a1] & ":")[/COLOR]
End If
Range("A2").NumberFormat = "@"
If Len([a2]) = 1 Then [a2] = "00" & [a2]
If Len([a2]) = 2 Then [a2] = "0" & [a2]
End If
a3 = Range("A3")
If Mid(a3, 2, 1) Like "[a-zA-Z]" Then
a3 = Left(a3, 2) & " " & Right(a3, 1)
Range("A3") = UCase(a3)
Else
a3 = [COLOR=#ff0000]UCase(Left(a3, 1))[/COLOR] & "'ly " & Right(a3, 1)
Range("A3") = a3
End If
End If
Application.EnableEvents = True
End Sub``````

Rick Rothstein

MrExcel MVP
Here is another way to write the Change event procedure...
Code:
``````Private Sub Worksheet_Change(ByVal Target As Range)
Dim IsDigit As Boolean
Application.EnableEvents = False
If Target.Address(0, 0) = "A1" Then
[A1] = [IF(RIGHT(A1)<>":",A1&":",A1)]
ElseIf Target.Address(0, 0) = "A2" Then
[A2].NumberFormat = "000"
ElseIf Target.Address(0, 0) = "A3" Then
IsDigit = Mid(Replace([A3], " ", ""), 2, 1) Like "#"
[A3] = Application.Replace(Replace([A3], " ", ""), 3 + IsDigit, 0, Choose(2 + IsDigit, "'ly ", " "))
End If
Application.EnableEvents = True
End Sub``````

sassriverrat

Well-known Member
Well let's try posting again!

Ok- I tried both methods in with a whole slew of other stuff I have in the worksheet_change coding.

Neither seem to have worked and I'm not sure why. In the sheet, for this particular case, D12 = R11 where R11 is where the user can input data and D12 is where it shows up (in a locked-cell that's formatted to look nice). Sheet is named "Noon". Both iterations of code are in red.

Note: I've cleaned out some stuff just to shorten this code- nothing removed was important

Rich (BB code):
``````Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)On Error GoTo Helper
If sh.name = "Notes" _
Or sh.name = "Ports" _
Or sh.name = "Voyage Specifics" _
Then Exit Sub
Dim isdigit As Boolean 'this is the weather direction "'ly's"

With Application
.EnableEvents = False
.ScreenUpdating = False
If sh.name = "Developer" Then
If Right([e42], 1) <> ":" Then [e42] = UCase([e42] & ":")
End If
If Right([j48], 1) <> ":" Then [j48] = UCase([j48] & ":")
End If
Exit Sub
End If

If Cells(25, 23) <> "" Then
Cells(4, 6) = Cells(25, 23).Value
Cells(4, 6).NumberFormat = "dd-mmm-yy"
ElseIf Cells(5, 18) <> "" And Cells(25, 23) = "" Then
Cells(4, 6) = Date
Cells(4, 6).NumberFormat = "dd-mmm-yy"
ElseIf Cells(5, 18) = "" And Cells(6, 23) = "" Then
Cells(4, 6) = "No Data Input"
End If
Range("N5").NumberFormat = "@"
If Len([n5]) = 1 Then [n5] = "00" & [n5]
If Len([n5]) = 2 Then [n5] = "0" & [n5]
End If

If Target.Address(0, 0) = ("\$D\$12") Then
d12 = Range("D12")
If Mid(d12, 2, 1) Like "[a-zA-Z]" Then
d12 = Left(a3, 2) & " " & Right(d12, 1)
Range("D12") = UCase(d12)
Else
d12 = UCase(Left(d12, 1)) & "'ly " & Right(d12, 1)
Range("D12") = d12
End If
End If

If Target.Address(0, 0) = "R11" Then
isdigit = Mid(Replace([R11], " ", ""), 2, 1) Like "#"
[R11] = Application.Replace(Replace([R11], " ", ""), 3 + isdigit, 0, Choose(2 + isdigit, "'ly ", " "))
End If

If sh.name = "Arrival" Then
If Cells(20, 26) <> "Yes" Then
Range("R6").Select
With Selection
***Formatting code***
End With
ElseIf Cells(20, 26) <> "No" Then
Cells(6, 18) = "EXACT"
Range("R6").Select
With Selection
***Formatting code***
End With
Range("R7").Select
End If
ElseIf Cells(20, 26) <> "Yes" Then
Range("R9").Select
With Selection
***Formatting code***
End With
Range("R6").Select
ElseIf Cells(20, 26) <> "No" Then
Cells(9, 18) = "EXACT"
Range("R9").Select
With Selection
***Formatting code***
End With
Range("R6").Select
End If
End If

.EnableEvents = True
.ScreenUpdating = True

End With

'Error Clearing Code
Exit Sub
Helper:
***ERROR CODING***

End Sub``````

sassriverrat

Well-known Member
So I quickly realized my error here- all of my code above is in the ThisWorkbook section...not the individual sheet. How would you go about tweaking it to work in the ThisWorkbook section? My thoughts- my workbook has buttons that dynamically add/delete sheets as required. The sheets that this would need to affect are all added/removed by the user- they aren't the "fixed" sheets- so unless this was written into my sheet-creation coding, they would be deleted during first use.

Paul Ked

Active Member
So basically you asked the wrong question in the beginning.

sassriverrat

Well-known Member
So basically you asked the wrong question in the beginning.
Hmm. I don't think so. How would you change your code so that it can be used in the ThisWorkbook section instead of the individual sheet's section? That way, it can be applied to all of the sheets in the workbook? It's unfortunately not as easy as just changing the worksheet_change to workbook_change.....

Last edited:

Paul Ked

Active Member
In the This Workbook code module

Code:
``````Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "Sheet1" Then Exit Sub
Application.EnableEvents = False
Dim a3 As String
If Right([A1], 1) <> ":" Then [A1] = UCase([A1] & ":")
End If
Range("A2").NumberFormat = "@"
If Len([A2]) = 1 Then [A2] = "00" & [A2]
If Len([A2]) = 2 Then [A2] = "0" & [A2]
End If
a3 = Range("A3")
If Mid(a3, 2, 1) Like "[a-zA-Z]" Then
a3 = Left(a3, 2) & " " & Right(a3, 1)
Range("A3") = UCase(a3)
Else
a3 = UCase(Left(a3, 1)) & "'ly " & Right(a3, 1)
Range("A3") = a3
End If
End If
Application.EnableEvents = True
End Sub``````

sassriverrat

Well-known Member
Worked perfectly. Little tweaking to get into my workbook but the basis for the code was perfect! Thanks!