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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Hi,
my version without the red formatting
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
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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.
ASKER
Thanks for your patience!
Andrea