Cell Formatting

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
655
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!
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
In the Worksheet code module:

Code:
Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Dim a3 As String
    If Target.Address = ("$A$1") Then
        If Right([a1], 1) <> ":" Then [a1] = [a1] & ":"
    End If
    If Target.Address = ("$A$2") Then
        Range("A2").NumberFormat = "@"
        If Len([a2]) = 1 Then [a2] = "00" & [a2]
        If Len([a2]) = 2 Then [a2] = "0" & [a2]
    End If
    If Target.Address = ("$A$3") Then
        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:
Upvote 0
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 Target.Address = ("$A$1") Then
        If Right([a1], 1) <> ":" Then [a1] = [COLOR=#ff0000]UCase([a1] & ":")[/COLOR]
    End If
    If Target.Address = ("$A$2") Then
        Range("A2").NumberFormat = "@"
        If Len([a2]) = 1 Then [a2] = "00" & [a2]
        If Len([a2]) = 2 Then [a2] = "0" & [a2]
    End If
    If Target.Address = ("$A$3") Then
        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
 
Upvote 0
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
 
Upvote 0
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 Target.Address = "E42" Then
        If Right([e42], 1) <> ":" Then [e42] = UCase([e42] & ":")
    End If
    If Target.Address = "J48" Then
        If Right([j48], 1) <> ":" Then [j48] = UCase([j48] & ":")
    End If
    Exit Sub
End If


If Target.Address(0, 0) = "R5" Or Target.Address(0, 0) = "W25" Then
    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
If Target.Address = ("N5") Then
    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
 
Upvote 0
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.
 
Upvote 0
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:
Upvote 0
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 Target.Address = ("$A$1") Then
        If Right([A1], 1) <> ":" Then [A1] = UCase([A1] & ":")
    End If
    If Target.Address = ("$A$2") Then
        Range("A2").NumberFormat = "@"
        If Len([A2]) = 1 Then [A2] = "00" & [A2]
        If Len([A2]) = 2 Then [A2] = "0" & [A2]
    End If
    If Target.Address = ("$A$3") Then
        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
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,188
Members
448,554
Latest member
Gleisner2

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