📄VB Code – With Excel + SAP B1

Make your Excel a powerful tool with below VB codes

Shortcut key for VB in Excel is Alt+F11 & for Macros Alt+F8

Convert Numbers into words

Function ConvertToIndianWords(ByVal MyNumber) Dim Rupees As String, Paise As String Dim DecimalPlace As Integer Dim TempStr As String Dim PaisePart As String MyNumber = Trim(Str(MyNumber)) DecimalPlace = InStr(MyNumber, ".") If DecimalPlace > 0 Then PaisePart = Mid(MyNumber, DecimalPlace + 1) MyNumber = Left(MyNumber, DecimalPlace - 1) Else PaisePart = "" End If TempStr = ConvertWholeNumberToWords(MyNumber) If PaisePart <> "" Then If Len(PaisePart) = 1 Then PaisePart = PaisePart & "0" ' e.g. .5 becomes .50 Paise = " and " & ConvertTens(PaisePart) & " Paise" End If ConvertToIndianWords = Application.Trim(TempStr & Paise) End Function Private Function ConvertWholeNumberToWords(ByVal num As String) As String Dim words As String Dim n As Double n = Val(num) If n = 0 Then ConvertWholeNumberToWords = "Zero" Exit Function End If words = "" If n >= 10000000 Then words = words & ConvertHundreds(Int(n / 10000000)) & " Crore " n = n Mod 10000000 End If If n >= 100000 Then words = words & ConvertHundreds(Int(n / 100000)) & " Lakh " n = n Mod 100000 End If If n >= 1000 Then words = words & ConvertHundreds(Int(n / 1000)) & " Thousand " n = n Mod 1000 End If If n >= 100 Then words = words & ConvertHundreds(Int(n / 100)) & " Hundred " n = n Mod 100 End If If n > 0 Then If words <> "" Then words = words & "and " words = words & ConvertTens(n) End If ConvertWholeNumberToWords = Application.Trim(words) End Function Private Function ConvertHundreds(ByVal n As Integer) As String Dim word As String If n > 99 Then word = GetDigit(Int(n / 100)) & " Hundred " n = n Mod 100 End If If n > 0 Then word = word & ConvertTens(n) End If ConvertHundreds = word End Function Private Function ConvertTens(ByVal n As Variant) As String Dim teensArray(9 To 19) As String Dim tensArray(2 To 9) As String Dim unitsArray(1 To 9) As String teensArray(10) = "Ten": teensArray(11) = "Eleven": teensArray(12) = "Twelve" teensArray(13) = "Thirteen": teensArray(14) = "Fourteen": teensArray(15) = "Fifteen" teensArray(16) = "Sixteen": teensArray(17) = "Seventeen": teensArray(18) = "Eighteen": teensArray(19) = "Nineteen" tensArray(2) = "Twenty": tensArray(3) = "Thirty": tensArray(4) = "Forty" tensArray(5) = "Fifty": tensArray(6) = "Sixty": tensArray(7) = "Seventy" tensArray(8) = "Eighty": tensArray(9) = "Ninety" unitsArray(1) = "One": unitsArray(2) = "Two": unitsArray(3) = "Three" unitsArray(4) = "Four": unitsArray(5) = "Five": unitsArray(6) = "Six" unitsArray(7) = "Seven": unitsArray(8) = "Eight": unitsArray(9) = "Nine" Dim t As Integer: t = Int(n) Dim Result As String If t = 0 Then Result = "" ElseIf t < 10 Then Result = unitsArray(t) ElseIf t >= 10 And t < 20 Then Result = teensArray(t) Else Result = tensArray(Int(t / 10)) If t Mod 10 > 0 Then Result = Result & " " & unitsArray(t Mod 10) End If End If ConvertTens = Result End Function Private Function GetDigit(ByVal Digit) Select Case Val(Digit) Case 1: GetDigit = "One" Case 2: GetDigit = "Two" Case 3: GetDigit = "Three" Case 4: GetDigit = "Four" Case 5: GetDigit = "Five" Case 6: GetDigit = "Six" Case 7: GetDigit = "Seven" Case 8: GetDigit = "Eight" Case 9: GetDigit = "Nine" Case Else: GetDigit = "" End Select End Function

Extract Address in 100 charcter with City, State, pincode in separate cell

Sub ProcessAddresses() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row Dim cities As Variant cities = Array("Mumbai", "Delhi", "Bangalore", "Hyderabad", "Ahmedabad", "Chennai", "Kolkata", "Surat", "Pune", "Jaipur", _ "Lucknow", "Kanpur", "Nagpur", "Indore", "Thane", "Bhopal", "Visakhapatnam", "Patna", "Vadodara", "Ghaziabad", _ "Ludhiana", "Agra", "Nashik", "Faridabad", "Meerut", "Rajkot", "Kalyan", "Vasai", "Varanasi", "Srinagar", _ "Aurangabad", "Dhanbad", "Amritsar", "Navi Mumbai", "Prayagraj", "Ranchi", "Howrah", "Coimbatore", "Jabalpur", "Gwalior") Dim countries As Variant countries = Array("India", "USA", "UK", "Canada", "Australia") ' State name and short code pairs Dim stateData As Variant stateData = Array( _ Array("Andhra Pradesh", "AP"), Array("Arunachal Pradesh", "AR"), Array("Assam", "AS"), _ Array("Bihar", "BR"), Array("Chhattisgarh", "CG"), Array("Goa", "GA"), _ Array("Gujarat", "GJ"), Array("Haryana", "HR"), Array("Himachal Pradesh", "HP"), _ Array("Jharkhand", "JH"), Array("Karnataka", "KA"), Array("Kerala", "KL"), _ Array("Madhya Pradesh", "MP"), Array("Maharashtra", "MH"), Array("Manipur", "MN"), _ Array("Meghalaya", "ML"), Array("Mizoram", "MZ"), Array("Nagaland", "NL"), _ Array("Odisha", "OD"), Array("Punjab", "PB"), Array("Rajasthan", "RJ"), _ Array("Sikkim", "SK"), Array("Tamil Nadu", "TN"), Array("Telangana", "TS"), _ Array("Tripura", "TR"), Array("Uttar Pradesh", "UP"), Array("Uttarakhand", "UK"), _ Array("West Bengal", "WB") _ ) Dim i As Long For i = 2 To lastRow Dim fullAddress As String fullAddress = Trim(ws.Cells(i, "A").Value) If fullAddress = "" Then GoTo NextRow ' Remove duplicate words Dim words() As String Dim uniqueWords As Object: Set uniqueWords = CreateObject("Scripting.Dictionary") words = Split(fullAddress, " ") Dim cleanedAddress As String: cleanedAddress = "" Dim w As Variant For Each w In words If Not uniqueWords.exists(LCase(w)) Then uniqueWords.Add LCase(w), w cleanedAddress = cleanedAddress & w & " " End If Next w cleanedAddress = Trim(cleanedAddress) ' Extract and remove pincode Dim pincode As String pincode = ExtractPincode(cleanedAddress) If pincode <> "" Then ws.Cells(i, "I").Value = pincode cleanedAddress = Replace(cleanedAddress, pincode, "", , , vbTextCompare) End If ' Extract and remove state (full name or short code) Dim state As String state = ExtractState(cleanedAddress, stateData) If state <> "" Then ws.Cells(i, "G").Value = state ws.Cells(i, "J").Value = GetStateShortCode(state, stateData) cleanedAddress = Replace(cleanedAddress, state, "", , , vbTextCompare) cleanedAddress = Replace(cleanedAddress, GetStateShortCode(state, stateData), "", , , vbTextCompare) End If ' Extract and remove country Dim country As String country = ExtractComponent(cleanedAddress, countries) If country <> "" Then ws.Cells(i, "H").Value = country cleanedAddress = Replace(cleanedAddress, country, "", , , vbTextCompare) End If ' Extract and remove city Dim city As String city = ExtractComponent(cleanedAddress, cities) If city <> "" Then ws.Cells(i, "F").Value = city cleanedAddress = Replace(cleanedAddress, city, "", , , vbTextCompare) End If cleanedAddress = Application.WorksheetFunction.Trim(cleanedAddress) ' Split cleanedAddress into 100-character chunks (B to E) Dim tokens() As String tokens = Split(cleanedAddress, " ") Dim chunk As String: chunk = "" Dim colOffset As Integer: colOffset = 1 ' Start at column B Dim j As Long For j = LBound(tokens) To UBound(tokens) If Len(chunk & " " & tokens(j)) <= 100 Then chunk = chunk & " " & tokens(j) Else ws.Cells(i, colOffset + 1).Value = Trim(chunk) colOffset = colOffset + 1 If colOffset > 4 Then Exit For chunk = tokens(j) End If Next j If chunk <> "" And colOffset <= 4 Then ws.Cells(i, colOffset + 1).Value = Trim(chunk) End If NextRow: Next i MsgBox "Address processing complete." End Sub Function ExtractPincode(text As String) As String Dim re As Object: Set re = CreateObject("VBScript.RegExp") re.Pattern = "\b\d{5,6}\b" re.Global = False re.IgnoreCase = True Dim matches As Object Set matches = re.Execute(text) If matches.Count > 0 Then ExtractPincode = matches(0) Else ExtractPincode = "" End If End Function Function ExtractComponent(text As String, list As Variant) As String Dim item As Variant For Each item In list If InStr(1, text, item, vbTextCompare) > 0 Then ExtractComponent = item Exit Function End If Next item ExtractComponent = "" End Function Function ExtractState(text As String, stateData As Variant) As String Dim i As Long For i = LBound(stateData) To UBound(stateData) If InStr(1, text, stateData(i)(0), vbTextCompare) > 0 Then ExtractState = stateData(i)(0) Exit Function ElseIf InStr(1, text, " " & stateData(i)(1) & " ", vbTextCompare) > 0 Or _ Right(LCase(text), 3) = " " & LCase(stateData(i)(1)) Then ExtractState = stateData(i)(0) Exit Function End If Next i ExtractState = "" End Function Function GetStateShortCode(state As String, stateData As Variant) As String Dim i As Long For i = LBound(stateData) To UBound(stateData) If StrComp(state, stateData(i)(0), vbTextCompare) = 0 Then GetStateShortCode = stateData(i)(1) Exit Function End If Next i GetStateShortCode = "" End Function

Convert Words into Number

Calculate Age in Years, Months, Days

Extract Only Numbers from Text

Convert to Proper Case (Better than Excel’s PROPER)

Convert Date to Words

Ledger OB Balance template creation for SAP B1

Sub GenerateSAPTemplate() Dim wsInput As Worksheet, wsOutput As Worksheet Dim lastRow As Long, i As Long, outputRow As Long Dim cutoffDate As String, sapCode As String, drcr As String Dim amount As Double, formattedDate As String ' Set worksheets Set wsInput = ThisWorkbook.Sheets("Sheet1") ' Create or clear Sheet2 On Error Resume Next Set wsOutput = ThisWorkbook.Sheets("Sheet2") If wsOutput Is Nothing Then Set wsOutput = ThisWorkbook.Sheets.Add(After:=wsInput) wsOutput.Name = "Sheet2" Else wsOutput.Cells.Clear End If On Error GoTo 0 ' Set headers wsOutput.Range("A1:E1").Value = Array("Duedate", "Code", "Name", "Balance(LC)", "OB (LC)") lastRow = wsInput.Cells(wsInput.Rows.Count, "A").End(xlUp).Row outputRow = 2 ' Loop through data rows For i = 2 To lastRow If wsInput.Cells(i, "A").Value <> "" Then ' Get values cutoffDate = wsInput.Cells(i, "A").Value sapCode = wsInput.Cells(i, "C").Value drcr = Trim(LCase(wsInput.Cells(i, "D").Value)) amount = wsInput.Cells(i, "E").Value ' Format date to YYYYMMDD On Error Resume Next formattedDate = Format(DateValue(cutoffDate), "yyyymmdd") On Error GoTo 0 ' Make amount negative if Cr If drcr = "cr" Then amount = -Abs(amount) ElseIf drcr = "dr" Then amount = Abs(amount) End If ' Fill output sheet With wsOutput .Cells(outputRow, 1).Value = formattedDate .Cells(outputRow, 2).Value = sapCode .Cells(outputRow, 3).Value = "" ' Name blank .Cells(outputRow, 4).Value = "" ' Balance(LC) blank .Cells(outputRow, 5).Value = amount End With outputRow = outputRow + 1 End If Next i MsgBox "SAP B1 Template Generated in Sheet2", vbInformation End Sub

Download the Template