Link to home
Start Free TrialLog in
Avatar of Andreamary
Andreamary

asked on

Truncate all numbers with 3 decimal places to 2 decimal places & highlight changed numbers in colour

I've inherited a large, somewhat poorly formatted, spreadsheet of communication frequencies. I am looking for a macro that will:

1. Truncate (not round) all numbers that have 3 decimal places down to 2 decimal places
2. If the 3-decimal number ends in "00", then number to be truncated down to 1 decimal place (ie., 135.100 becomes 135.1)
3. All numbers that change to turn the color red.

The cells can contain an alpha numeric mix and often have multiple entries in one cell using line breaks. The line breaks need to be maintained.

Here is a current and revised cell example:

Current cell format:
YYYYY Townname 126.425
250.156
98.100

Revised cell format:
YYYYY Townname 126.42
250.15
98.1

Thanks!
Andrea
SOLUTION
Avatar of nutsch
nutsch
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Andreamary
Andreamary

ASKER

I don't have a lot of macro experience so if you can just let me know if I create one macro for the above and paste the code into it, or do I create more than one macro?

Thanks for your patience!
Andrea
Avatar of Rgonzo1971
Hi,

my version without the red formatting
Sub Macro()
Dim c As Range
For Each c In ActiveSheet.UsedRange
    arrLines = Split(c, vbLf)
     For Each Ln In arrLines
        arrWrds = Split(Ln, " ")
        For Each wrd In arrWrds
            If IsNumeric(wrd) Then
                dblWrd = CDbl(wrd)
                Rest = dblWrd - Int(dblWrd)
                If Rest <> 0 Then ' not integer
                    Number = Fix(dblWrd * 100) / 100
                    NewWrd = Format(Number, "#.0#")
                    MsgBox NewWrd
                Else
                    NewWrd = wrd
                End If
            Else
                NewWrd = wrd
            End If
        NewLine = NewLine & NewWrd & " "
        Next
    NewLine = Left(NewLine, Len(NewLine) - 1)
    Result = Result & NewLine & vbLf
    NewLine = ""
    Next
c.Value = Left(Result, Len(Result) - 1)
Result = ""
Next
End Sub

Open in new window

Regards
Go into the visual basic editor (alt+F11), select your workbook and choose Insert \ Module from the top menu bar.

Copy all the code in the module.

Run by using Alt+F8 from your worksheet, or F5 from VB Editor.

The code will run on all cells in column A.

I'd recommend saving a backup copy of your workbook before launching the macro, macros cannot be undone generally.

Thomas
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thanks Rgonzo, your second formula worked perfectly across all columns (there were 24+ columns). Thanks, Thomas, for your answer and step-by-step on how to insert the code. Because the code needed to work across 24+ columns and the red formatting was a critical component I selected Rgonzo's formula as the best solution, but appreciated your input.