Monday, October 20, 2014

Convert a numeric value into English words in Excel



 

1.  Option Explicit
2.  'Main Function
3.  Function SpellNumber(ByVal MyNumber)
4.      Dim Dollars, Cents, Temp
5.      Dim DecimalPlace, Count
6.      ReDim Place(9) As String
7.      Place(2) = " Thousand "
8.      Place(3) = " Million "
9.      Place(4) = " Billion "
10.     Place(5) = " Trillion "
11.     ' String representation of amount.
12.     MyNumber = Trim(Str(MyNumber))
13.     ' Position of decimal place 0 if none.
14.     DecimalPlace = InStr(MyNumber, ".")
15.     ' Convert cents and set MyNumber to dollar amount.
16.     If DecimalPlace > 0 Then
17.         Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
18.                   "00", 2))
19.         MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
20.     End If
21.     Count = 1
22.     Do While MyNumber <> ""
23.         Temp = GetHundreds(Right(MyNumber, 3))
24.         If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
25.         If Len(MyNumber) > 3 Then
26.             MyNumber = Left(MyNumber, Len(MyNumber) - 3)
27.         Else
28.             MyNumber = ""
29.         End If
30.         Count = Count + 1
31.     Loop
32.     Select Case Dollars
33.         Case ""
34.             Dollars = "No Dollars"
35.         Case "One"
36.             Dollars = "One Dollar"
37.          Case Else
38.             Dollars = Dollars & " Dollars"
39.     End Select
40.     Select Case Cents
41.         Case ""
42.             Cents = " and No Cents"
43.         Case "One"
44.             Cents = " and One Cent"
45.               Case Else
46.             Cents = " and " & Cents & " Cents"
47.     End Select
48.     SpellNumber = Dollars & Cents
49. End Function
50.       
51. ' Converts a number from 100-999 into text 
52. Function GetHundreds(ByVal MyNumber)
53.     Dim Result As String
54.     If Val(MyNumber) = 0 Then Exit Function
55.     MyNumber = Right("000" & MyNumber, 3)
56.     ' Convert the hundreds place.
57.     If Mid(MyNumber, 1, 1) <> "0" Then
58.         Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
59.     End If
60.     ' Convert the tens and ones place.
61.     If Mid(MyNumber, 2, 1) <> "0" Then
62.         Result = Result & GetTens(Mid(MyNumber, 2))
63.     Else
64.         Result = Result & GetDigit(Mid(MyNumber, 3))
65.     End If
66.     GetHundreds = Result
67. End Function
68.       
69. ' Converts a number from 10 to 99 into text. 
70. Function GetTens(TensText)
71.     Dim Result As String
72.     Result = ""           ' Null out the temporary function value.
73.     If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...
74.         Select Case Val(TensText)
75.             Case 10: Result = "Ten"
76.             Case 11: Result = "Eleven"
77.             Case 12: Result = "Twelve"
78.             Case 13: Result = "Thirteen"
79.             Case 14: Result = "Fourteen"
80.             Case 15: Result = "Fifteen"
81.             Case 16: Result = "Sixteen"
82.             Case 17: Result = "Seventeen"
83.             Case 18: Result = "Eighteen"
84.             Case 19: Result = "Nineteen"
85.             Case Else
86.         End Select
87.     Else                                 ' If value between 20-99...
88.         Select Case Val(Left(TensText, 1))
89.             Case 2: Result = "Twenty "
90.             Case 3: Result = "Thirty "
91.             Case 4: Result = "Forty "
92.             Case 5: Result = "Fifty "
93.             Case 6: Result = "Sixty "
94.             Case 7: Result = "Seventy "
95.             Case 8: Result = "Eighty "
96.             Case 9: Result = "Ninety "
97.             Case Else
98.         End Select
99.         Result = Result & GetDigit _
100.                (Right(TensText, 1))  ' Retrieve ones place.
101.        End If
102.        GetTens = Result
103.    End Function
104.         
105.    ' Converts a number from 1 to 9 into text. 
106.    Function GetDigit(Digit)
107.        Select Case Val(Digit)
108.            Case 1: GetDigit = "One"
109.            Case 2: GetDigit = "Two"
110.            Case 3: GetDigit = "Three"
111.            Case 4: GetDigit = "Four"
112.            Case 5: GetDigit = "Five"
113.            Case 6: GetDigit = "Six"
114.            Case 7: GetDigit = "Seven"
115.            Case 8: GetDigit = "Eight"
116.            Case 9: GetDigit = "Nine"
117.            Case Else: GetDigit = ""
118.        End Select
119.    End Function

Remove Duplicates from a selection

Sheets(2).Range(Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Address).RemoveDuplicates Columns:=1, Header:=xlNo

Wednesday, October 15, 2014

To open last modified file from a folder:

Const myDir = "H:\Test\backup-stephen's workbook"
Sub GetLatestFile()

Dim fso As Object
Set fso = CreateObject("scripting.filesystemobject")
Dim fil As Object
Dim myFolder
Dim myFilename As String
Dim dateOfFile As Date


'set up initial folder
Set myFolder = fso.GetFolder(myDir)


'To loop through each file and get date last modified. If largest date then store Filename

dateOfFile = DateSerial(1900, 1, 1)
For Each fil In myFolder.Files
If fil.DateLastModified > dateOfFile Then
dateOfFile = fil.DateLastModified '  this is the important logic
myFilename = fil.Name
End If
Next fil
Workbooks.Open myFilename

Set FileSys = Nothing
Set myFolder = Nothing
End Sub


 

Sunday, July 27, 2014

Welcome

This blog can be used for free.
I have created this blog so that I can quickly access my codes whenever I need. I usually very poor in memoriusing stuffs.

But I am heavy user of VBA & excel in my work and love to share my experience if anyone needed.

Please feel free to use this site, post your experience and help us develop skills.
-Syed Uddin,2014