View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
stevebriz stevebriz is offline
external usenet poster
 
Posts: 195
Default replacing dynamic currency amounts with a character

hi tony
I just did something similar...
has another check..
1/ accounts for if the number that end like 0.20 has only 0.2
showing...

Dim i As Integer ' for rows
Dim j As Integer ' for columns
Sheet1.Activate
Sheet1.Cells(1, 1).Select
' lets assume the number you want to change is is rows 1-20 in column
1(A)on sheet 1
Sheet1.Activate ' show sheet 1
Sheet1.Cells(1, 1).Select ' select sheet 1 A1
j = 1 ' 1 = column A
For i = 1 To 20 ' rows 1 to 20
If Cells(i, j).Value = vbNullString Then ' check the cell is
not empty
Else
If Not IsNumeric(Right$(Cells(i, j).Value, 1)) Then '
checks last char is a number

Else
' this to cover if the zeros are dropped after
the decimal point

If Mid(Cells(i, j).Value, ((Len(Cells(i,
j).Value) - 2)), 1) < "." Then
Cells(i, j).Value = Cells(i, j).Value & "}"
Else
' truncates the string and adds the correct
character from function
Cells(i, j).Value = Left$(Cells(i, j).Value,
Len(Cells(i, j).Value) - 1) & newlastchar(Right$(Cells(i, j).Value, 1))
End If
End If

End If
Next i
End Sub

Function newlastchar(ln As Integer)

Select Case ln
Case 1
newlastchar = "J"
Case 2
newlastchar = "K"
Case 3
newlastchar = "L"
Case 4
newlastchar = "M"
Case 5
newlastchar = "N"
Case 6
newlastchar = "O"
Case 7
newlastchar = "P"
Case 8
newlastchar = "Q"
Case 9
newlastchar = "R"
Case 0
newlastchar = "}"

End Select
End Function