Cell Formatting

S

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!
 
Sort by date Sort by votes

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Gentleman- second two of the three formulas worked perfectly.

I haven't been able to get the first one to work. Just to make sure we are on the same page (because the code looks right), if I put the letter "C" or "c" in the cell, it should be corrected to "C:".

Thanks!
 
Upvote 0
Here's the direct portion

Rich (BB code): 
If sh.name = "Developer" Then  If Target.Address(0, 0) = "e42" Then
    e42 = Range("e42")
    [e42] = [IF(RIGHT(e42)<>":",e42&":",e42)]
    End If
End If

Also I tried this in the same spot
Rich (BB code): 
If sh.name = "Developer" Then
  If Target.Address = ("$A$1") Then
        If Right([E42], 1) <> ":" Then [E42] = UCase([E42] & ":")
    End If

and the whole change portion
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 r8 As String 'this is the weather direction "'ly's"
Dim r9 As String 'this is the weather direction "'ly's"
Dim r10 As String 'this is the weather direction "'ly's"
Dim r11 As String 'this is the weather direction "'ly's"
Dim r12 As String 'this is the weather direction "'ly's"
Dim r13 As String 'this is the weather direction "'ly's"
With Application
    .EnableEvents = False
    .ScreenUpdating = False


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 sh.name = "Arrival" Then
        If Cells(20, 26) <> "Yes" Then
            Range("R6").Select
            With Selection
                .Locked = False
                .ClearContents
                .HorizontalAlignment = xlRight
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
                .Font.Bold = False
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).ColorIndex = 0
                .Borders(xlEdgeLeft).TintAndShade = 0
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).ColorIndex = 0
                .Borders(xlEdgeTop).TintAndShade = 0
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).ColorIndex = 0
                .Borders(xlEdgeBottom).TintAndShade = 0
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeRight).ColorIndex = 0
                .Borders(xlEdgeRight).TintAndShade = 0
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Interior.Pattern = xlSolid
                .Interior.PatternColorIndex = xlAutomatic
                .Interior.Color = 65535
                .Interior.TintAndShade = 0
                .Interior.PatternTintAndShade = 0
            End With
        ElseIf Cells(20, 26) <> "No" Then
            Cells(6, 18) = "EXACT"
            Range("R6").Select
            With Selection
                .Locked = True
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = True
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
                .Font.Bold = True
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                .Borders(xlEdgeLeft).LineStyle = xlNone
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).ColorIndex = 0
                .Borders(xlEdgeTop).TintAndShade = 0
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).ColorIndex = 0
                .Borders(xlEdgeBottom).TintAndShade = 0
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeRight).LineStyle = xlNone
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Interior.Pattern = xlNone
                .Interior.TintAndShade = 0
                .Interior.PatternTintAndShade = 0
            End With
            Range("R7").Select
        End If
    ElseIf Cells(20, 26) <> "Yes" Then
        Range("R9").Select
            With Selection
                .Locked = False
                .ClearContents
                .HorizontalAlignment = xlRight
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
                .Font.Bold = False
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).ColorIndex = 0
                .Borders(xlEdgeLeft).TintAndShade = 0
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).ColorIndex = 0
                .Borders(xlEdgeTop).TintAndShade = 0
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).ColorIndex = 0
                .Borders(xlEdgeBottom).TintAndShade = 0
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeRight).ColorIndex = 0
                .Borders(xlEdgeRight).TintAndShade = 0
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Interior.Pattern = xlSolid
                .Interior.PatternColorIndex = xlAutomatic
                .Interior.Color = 65535
                .Interior.TintAndShade = 0
                .Interior.PatternTintAndShade = 0
            End With
            Range("R6").Select
    ElseIf Cells(20, 26) <> "No" Then
        Cells(9, 18) = "EXACT"
        Range("R9").Select
            With Selection
                .Locked = True
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = True
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
                .Font.Bold = True
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                .Borders(xlEdgeLeft).LineStyle = xlNone
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).ColorIndex = 0
                .Borders(xlEdgeTop).TintAndShade = 0
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).ColorIndex = 0
                .Borders(xlEdgeBottom).TintAndShade = 0
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeRight).LineStyle = xlNone
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Interior.Pattern = xlNone
                .Interior.TintAndShade = 0
                .Interior.PatternTintAndShade = 0
            End With
        Range("R6").Select
    End If
End If


If sh.name = "Arrival" Then
    If Target.Address = ("$R$7") Then
        Range("R7").NumberFormat = "@"
        If Len([R7]) = 1 Then [R7] = "00" & [R7]
        If Len([R7]) = 2 Then [R7] = "0" & [R7]
    End If
Else:
    If Target.Address = ("$R$10") Then
        Range("R10").NumberFormat = "@"
        If Len([r10]) = 1 Then [r10] = "00" & [r10]
        If Len([r10]) = 2 Then [r10] = "0" & [r10]
    End If
End If
 


If sh.name = "Arrival" Then
    If Target.Address = ("$R$8") Then
        r8 = Range("R8")
        If Mid(r8, 2, 1) Like "[a-zA-Z]" Then
            r8 = Left(r8, 2) & " " & Right(r8, 1)
            Range("R8") = UCase(r8)
        Else
            r8 = UCase(Left(r8, 1)) & "'ly " & Right(r8, 1)
            Range("R8") = r8
        End If
    End If
    If Target.Address = ("$R$9") Then
        r9 = Range("R9")
        If Mid(r9, 2, 1) Like "[a-zA-Z]" Then
            r9 = Left(r9, 2) & " " & Right(r9, 1)
            Range("R9") = UCase(r9)
        Else
            r9 = UCase(Left(r9, 1)) & "'ly " & Right(r9, 1)
            Range("R9") = r9
        End If
    End If
    If Target.Address = ("$R$10") Then
        r10 = Range("R10")
        If Mid(r10, 2, 1) Like "[a-zA-Z]" Then
            r10 = Left(r10, 2) & " " & Right(r10, 1)
            Range("R10") = UCase(r10)
        Else
            r10 = UCase(Left(r10, 1)) & "'ly " & Right(r10, 1)
            Range("R10") = r10
        End If
    End If
Else:
    If Target.Address = ("$R$11") Then
        r11 = Range("R11")
        If Mid(r11, 2, 1) Like "[a-zA-Z]" Then
            r11 = Left(r11, 2) & " " & Right(r11, 1)
            Range("R11") = UCase(r11)
        Else
            r11 = UCase(Left(r11, 1)) & "'ly " & Right(r11, 1)
            Range("R11") = r11
        End If
    End If
    If Target.Address = ("$R$12") Then
        r12 = Range("R12")
        If Mid(r12, 2, 1) Like "[a-zA-Z]" Then
            r12 = Left(r12, 2) & " " & Right(r12, 1)
            Range("R12") = UCase(r12)
        Else
            r12 = UCase(Left(r12, 1)) & "'ly " & Right(r12, 1)
            Range("R12") = r12
        End If
    End If
    If Target.Address = ("$R$13") Then
        r13 = Range("R13")
        If Mid(r13, 2, 1) Like "[a-zA-Z]" Then
            r13 = Left(r13, 2) & " " & Right(r13, 1)
            Range("R13") = UCase(r13)
        Else
            r13 = UCase(Left(r13, 1)) & "'ly " & Right(r13, 1)
            Range("R13") = r13
        End If
    End If
End If
If sh.name = "Developer" Then
  If Target.Address(0, 0) = "e42" Then
    e42 = Range("e42")
    [e42] = [IF(RIGHT(e42)<>":",e42&":",e42)]
    End If
End If


    .EnableEvents = True
    .ScreenUpdating = True
    
End With


'Error Clearing Code
Exit Sub
Helper:
    resp = MsgBox("We're sorry to see you've encountered an error." & vbCrLf & vbCrLf & "To proceed, we recommend you contact the Developer " & _
    "with error codes [1013] and " & "[" & Err.Number & "-" & Err.Description & "]." & vbCrLf & vbCrLf & "To attempt to patch your problem at least " & _
    "temporarily, we recommend you click [Yes] to see help directions. Would you like to continue?", vbYesNoCancel, name)
        If resp = vbYes Then
            Call Error_Handle(sprocname, Err.Number, Err.Description)
        ElseIf resp = vbNo Then
            Exit Sub
        ElseIf resp = vbCancel Then
            Exit Sub
        End If
        
End Sub
 
Upvote 0
Also I tried this in the same spot
Code:
If sh.name = "Developer" Then
If Target.Address = ("$A$1") Then
If Right([E42], 1) <> ":" Then [E42] = UCase([E42] & ":")
End If
Click to expand...

Code: 
    If Target.Address = ("[COLOR=#ff0000]$E$42[/COLOR]") Then
        If Right([E42], 1) <> ":" Then [E42] = UCase([E42] & ":")
    End If
 
Upvote 0
Sorry- so that mistake was actually fixed in my piece of code.

Issue I found here that I had missed- Cells E42 and F42 are merged. As such, your piece of code didn't work. Is there anyway around this? I usually try to avoid merged cells but this one is there for aesthetics....
 
Upvote 0
Paul Ked said:
It does work, at least on my worksheet, with E42 & F42 merged.
Click to expand...
So I ran this in a new workbook without E42 and F42 merged and it didn't work. Maybe I'm missing something?
Code: 
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)


With Application
    .EnableEvents = False
    .ScreenUpdating = False


    If Target.Address = ("$E$42") Then
        If Right([E42], 1) <> ":" Then [E42] = UCase([E42] & ":")
    End If


.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question
Format a Table Cell based on another cell value, without VBA
Replies
5
Views
80
etaf
etaf
rjplante
  • Question
sort numbers with letters
2 3
Replies
20
Views
228
Akuini
Akuini
N
  • Solved
Formula to change font color in part of cell only
Replies
2
Views
324
Nathan Asius
N
K
  • Question
Return a user specified number of cell values to a comma list randomly
Replies
1
Views
64
Eric W
Eric W
I
  • Solved
Delete vale reference number before user form is populated
2
Replies
14
Views
290
ipbr21054
I

Forum statistics

Threads
1,214,653
Messages
6,120,751
Members
448,989
Latest member
mariah3

Share this page

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