Wednesday, February 18, 2009

VBA Excel - Formatting a column of numbers to a given precision, stripping out the decimal place, and adding leading zeros to satisfy a minimum length

'Return the number dNumber increased to the power iExponent
Function Pow(ByVal dNumber As Double, ByVal iExponent As Integer) As Double
Pow = 1

Dim iCounter As Integer

For iCounter = 1 To iExponent
Pow = Pow * dNumber
Next iCounter
End Function

'Convert the values in the active column to the given precision, with no decimal place, filled with leading zeros to satisfy a minimum length
Sub ConvertColToTextNoDecimal(ByVal iPrecision As Integer, ByVal iMinimumLength As Integer)
Dim row As Long
Dim col As Long

col = Selection.Column 'We are going to process whatever column is currently selected

Dim val As Variant

For row = 2 To ActiveSheet.UsedRange.Rows.Count 'Assume we are processing from below a header row to the last used row in the selected sheet
val = ActiveSheet.Cells(row, col).Value 'Get the current value

On Error GoTo NextRow
val = CStr(Round(CDbl(val) * Pow(10, iPrecision), 0)) 'Round to the given precision, then shift off the decimal place

While Len(val) < iMinimumLength 'If the value we have isn't long enough:
val = "0" & val 'Prepend a zero

ActiveSheet.Cells(row, col).FormulaR1C1 = "'" & val 'Mark this value as text, so we don't lose any leading zeros
On Error GoTo 0
Next row

End Sub

Example usage:

'Round to 3 decimal places, remove the decimal point
Sub ConvertColTo3Dec()
ConvertColToTextNoDecimal 3, 0

'Round to 2 decimal places, remove the decimal point
Sub ConvertColTo2Dec()
ConvertColToTextNoDecimal 2, 0
End Sub

'Round to 1 decimal place, remove the decimal point
Sub ConvertColTo1Dec()
ConvertColToTextNoDecimal 1, 0
End Sub

'Round to 0 decimal places
Sub ConvertColTo0Dec()
ConvertColToTextNoDecimal 0, 0
End Sub

'No decimal place changes, but force enough leading zeros for 3 digits
Sub ConvertColTo0Filled3Long()
ConvertColToTextNoDecimal 0, 3
End Sub

No comments:

Post a Comment