VBA needs to add ".0" (as 1.0)

sksanjeev786

Well-known Member
Joined
Aug 5, 2020
Messages
884
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi Team,

I have been using the below macro recently which change the color as per my requirement and everything works perfectly but i need to add .0 if we have a single decimal column C,D,E and G with yellow highlighted.

Can anyone help me with this?

VBA Code:
Sub ColourNumbers()
Dim Lrow As Long, Lcol As Long
Dim rng As Range

With Sheets("Sheet1") 'change to your sheet name or use With ActiveSheet
    Lrow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Lcol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
End With
For Each rng In Range(Cells(1, 2), Cells(Lrow, Lcol))
    If Trim(InStr(rng, " ")) = 0 Then
        rng.Font.Color = vbBlack
    Else
        rng.Characters(1, InStr(rng, " ")).Font.Color = vbBlack
    End If
Next

End Sub



Book1
ABCDEFG
1Unaided Brand Awareness (First Mention)27-0.9-6.0 q0.4271.5
2Unaided Brand Awareness (Any Mention)470.8-6.5 q-0.247-0.2
3Aided Brand Awareness853.6 r3.9 r1851.5
4Message Association17-2.8-3.90.7170.5
5Book Intent - Business290.21.2-0.9293
6Book Intent - Personal/Leisure5900.30.9590.1
7Leisure Travel Consideration603.23.3260-0.2
8Business Travel Consideration9-2.5-1-2.59-4.3 q
9Affinity533.6-1.5-3.853-1.4
10Unique323.9-0.5-3.9326.0 p
11Meets Needs52-1.80.1-0.552-0.7
Sheet1
 
Last edited by a moderator:

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
I'm not following your problem. Why don't you go on the worksheet and format the whole columns to have 1 digit after the decimal point?

Also InStr returns a number. Why are you using Trim on it?
 
Upvote 0
@sksanjeev786
When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.
 
Upvote 0
May be this helps:

VBA Code:
Sub ColourNumbers()
Dim i&, j&, s, rng As Range, cell As Range
With Sheets("Sheet1")
    Set rng = Range("B1").CurrentRegion
    For i = 1 To rng.Rows.Count
        For j = 2 To rng.Columns.Count
            Set cell = rng.Cells(i, j)
            If IsNumeric(cell) Then
                cell.Font.Color = vbBlack
            Else
                s = Split(cell) '==> cell = "6.0 p" then s(0) = 6.0; s(1) = "p"
                cell.Characters(1, Len(s(0))).Font.Color = vbBlack ' change 6.0 color
            End If
            Select Case j
                Case 3, 4, 5, 7 ' case column C,D,E,G
                    cell.NumberFormat = "0.0"
            End Select
        Next
    Next
End With
End Sub
 
Upvote 1
Solution
May be this helps:

VBA Code:
Sub ColourNumbers()
Dim i&, j&, s, rng As Range, cell As Range
With Sheets("Sheet1")
    Set rng = Range("B1").CurrentRegion
    For i = 1 To rng.Rows.Count
        For j = 2 To rng.Columns.Count
            Set cell = rng.Cells(i, j)
            If IsNumeric(cell) Then
                cell.Font.Color = vbBlack
            Else
                s = Split(cell) '==> cell = "6.0 p" then s(0) = 6.0; s(1) = "p"
                cell.Characters(1, Len(s(0))).Font.Color = vbBlack ' change 6.0 color
            End If
            Select Case j
                Case 3, 4, 5, 7 ' case column C,D,E,G
                    cell.NumberFormat = "0.0"
            End Select
        Next
    Next
End With
End Sub

Super!!! Perfect!!!!

Thank you Bebo :) for your time and help on this :)
 
Upvote 0
@sksanjeev786
When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.
Sure thank you so much, Peter for your guidance on this sure I will click on VBA Code

Hope after clicking on the VBA code i need to paste my VBA

VBA Code:
"
Sub ColourNumbers()
Dim i&, j&, s, rng As Range, cell As Range
With Sheets("Sheet1")
Set rng = Range("B1").CurrentRegion
For i = 1 To rng.Rows.Count
For j = 2 To rng.Columns.Count
Set cell = rng.Cells(i, j)
If IsNumeric(cell) Then
cell.Font.Color = vbBlack
Else
s = Split(cell) '==> cell = "6.0 p" then s(0) = 6.0; s(1) = "p"
cell.Characters(1, Len(s(0))).Font.Color = vbBlack ' change 6.0 color
End If
Select Case j
Case 3, 4, 5, 7 ' case column C,D,E,G
cell.NumberFormat = "0.0"
End Select
Next
Next
End With
"
Let me know if i am doing correct way or incorrect way :)
 
Upvote 0
I'm not following your problem. Why don't you go on the worksheet and format the whole columns to have 1 digit after the decimal point?

Also InStr returns a number. Why are you using Trim on it?

Got the solution for this.

Thanks for checking on this :) :)
 
Upvote 0
May be this helps:

VBA Code:
Sub ColourNumbers()
Dim i&, j&, s, rng As Range, cell As Range
With Sheets("Sheet1")
    Set rng = Range("B1").CurrentRegion
    For i = 1 To rng.Rows.Count
        For j = 2 To rng.Columns.Count
            Set cell = rng.Cells(i, j)
            If IsNumeric(cell) Then
                cell.Font.Color = vbBlack
            Else
                s = Split(cell) '==> cell = "6.0 p" then s(0) = 6.0; s(1) = "p"
                cell.Characters(1, Len(s(0))).Font.Color = vbBlack ' change 6.0 color
            End If
            Select Case j
                Case 3, 4, 5, 7 ' case column C,D,E,G
                    cell.NumberFormat = "0.0"
            End Select
        Next
    Next
End With
End Sub
Hi Bebo,

once again thank you so much for your help on this.

just wanted to check can we add "+" symbole (+0.8, +3.6 and for 0.0 it will be as 0.0 ) only and "-" data stay same..

Regards
Sanjeev
 
Upvote 0

Forum statistics

Threads
1,215,580
Messages
6,125,654
Members
449,245
Latest member
PatrickL

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