Free VBA Excel Scripts, Functions, XLS samples downloads with description
Welcome to the Free VBA Excel Scripts, Functions, XLS samples downloads with description webpage. To solve automatization task with Excel please use our Visual Basic for application (VBA) scripts, functions. All scripts works well in Excel 97, Excel 2000, Excel 2003 and Excel 2007, Excel 2010. For more compatibility all Excel files, presented here are in XLS format with description.
To View results of the working VBA scripts:
1. Open Blank Excel File
2. Enable Macros for Excel 97-2003 in Tools - Macro - Security - Security Level - Medium (Low).
For Excel 2007, Excel 2010 - Excel Options - Trust Center - Trust Center Settings - Macro Settings - Enable all macros.
3. Open XLS File from ZIP archive.
4. Press Alt+F11 key.
5. Press CTRL+G to view Immediate Window.
6. Click "ThisWorkbook" in the top left "Project - VBA Project" window.
7. Press "F5" button Run Macro.
' ****************** FindPos Script Code Start ******************
Function FindPos(SubSt, St)
FindPos = 0
If Len(SubSt) <= Len(St) Then
For p = 1 To Len(St) - Len(SubSt) + 1
If Mid(St, p, Len(SubSt)) = SubSt Then
FindPos = p
Exit Function
End If
Next p
End If
End Function
Sub FindPos_Sample_BeginWithSoftware_COM()
' This Script will find a substring within a string and returns first position, or zero if the substring will be not found
' This Function is a Case Sensitive
' Similar to the InSTR VBA Function
' Provided by BeginWithSoftware.COM
' Please enter substring here
MySubString = "Very"
' Please enter string here
MyString = "Thank You Very Much"
' Resulting Variable
FoundPosNum = FindPos(MySubString, MyString)
' Displaying Result in the Immediate Window - Press CTRL+G to view it
If FoundPosNum > 0 Then
Debug.Print "My SubString "; Chr(34); MySubString; Chr(34); " found at position "; FoundPosNum; " within "; Chr(34); MyString; Chr(34)
Else
Debug.Print "My SubString "; Chr(34); MySubString; Chr(34); " is not found within "; Chr(34); MyString; Chr(34)
End If
Debug.Print "Done."
End Sub
' ****************** FindPos Script Code End ******************
' ****************** ReverseString Script Code Start ******************
Function ReverseString(dirst)
ReverseString = ""
For dr = Len(dirst) To 1 Step -1
ReverseString = ReverseString + Mid(dirst, dr, 1)
Next dr
End Function
Sub ReverseString_Sample_BeginWithSoftware_COM()
' This Script will change all symbols in a reverse order
' Provided by BeginWithSoftware.COM
' Please enter string here
MyString = "1234567AZ"
' Resulting Variable
MyReverseResult = ReverseString(MyString)
' Displaying Result in the Immediate Window - Press CTRL+G to view it
Debug.Print "My String is "; Chr(34); MyString; Chr(34)
Debug.Print "My Reverse String is "; Chr(34); MyReverseResult; Chr(34)
Debug.Print "Done."
End Sub
' ****************** ReverseString Script Code End ******************
' ****************** RemoveSpaces Script Code Start ******************
Function RemoveSpaces(spst)
' Provided by BeginWithSoftware.COM
RemoveSpaces = ""
If Len(spst) > 0 Then
For rs = 1 To Len(spst)
rsbuk = Mid(spst, rs, 1)
If rsbuk = " " Then
RemoveSpaces = RemoveSpaces + ""
Else
RemoveSpaces = RemoveSpaces + rsbuk
End If
Next rs
End If
End Function
Sub RemoveSpaces_Sample_BeginWithSoftware_COM()
' This Script will remove all spaces symbols in a string variable
' Provided by BeginWithSoftware.COM
' Please enter string here
MyString = "In ter net"
' Resulting Variable
MyNoSpacesResult = RemoveSpaces(MyString)
' Displaying Result in the Immediate Window - Press CTRL+G to view it
Debug.Print "My String is "; Chr(34); MyString; Chr(34)
Debug.Print "My String Without Spaces is "; Chr(34); MyNoSpacesResult; Chr(34)
Debug.Print "Done."
End Sub
' ****************** RemoveSpaces Script Code End ******************
' ****************** CheckDigitsOnlyInString Script Code Start ******************
Function CheckDigitsOnlyInString(vst)
' Provided by BeginWithSoftware.COM
CheckDigitsOnlyInString = False
If Len(vst) > 0 Then
For vn = 1 To Len(vst)
vnbuk = Mid(vst, vn, 1)
If (vnbuk <> "0") And (vnbuk <> "1") And (vnbuk <> "2") And (vnbuk <> "3") And (vnbuk <> "4") And (vnbuk <> "5") And (vnbuk <> "6") And (vnbuk <> "7") And (vnbuk <> "8") And (vnbuk <> "9") Then
Exit Function
End If
Next vn
CheckDigitsOnlyInString = True
Else
Exit Function
End If
End Function
Sub CheckDigitsOnlyInString_Sample_BeginWithSoftware_COM()
' This Script will check a string variable to contain digits only from 0 to 9. If it is - returns TRUE, else FALSE
' Provided by BeginWithSoftware.COM
' Please enter string 1 here
MyString1 = "1234567890"
' Please enter string 2 here
MyString2 = "12345A67890"
' Resulting Variable for MyString1 variable
MyCheckedResult1 = CheckDigitsOnlyInString(MyString1)
' Resulting Variable for MyString2 variable
MyCheckedResult2 = CheckDigitsOnlyInString(MyString2)
' Displaying Result in the Immediate Window - Press CTRL+G to view it
If MyCheckedResult1 = True Then
Debug.Print "MyString1 "; Chr(34); MyString1; Chr(34); " contains digits only"
Else
Debug.Print "MyString1 "; Chr(34); MyString1; Chr(34); " not contains digits only"
End If
If MyCheckedResult2 = True Then
Debug.Print "MyString2 "; Chr(34); MyString2; Chr(34); " contains digits only"
Else
Debug.Print "MyString2 "; Chr(34); MyString2; Chr(34); " not contains digits only"
End If
Debug.Print "Done."
End Sub
' ****************** CheckDigitsOnlyInString Script Code End ******************
NOTE: Please Save Excel File before the Macro running
' ****************** DefineCurrentFolderPathForExcelFile Script Code Start ******************
Function ReverseString(dirst)
' Provided by BeginWithSoftware.COM
ReverseString = ""
For dr = Len(dirst) To 1 Step -1
ReverseString = ReverseString + Mid(dirst, dr, 1)
Next dr
End Function
Function FindPos(SubSt, St)
' Provided by BeginWithSoftware.COM
FindPos = 0
If Len(SubSt) <= Len(St) Then
For p = 1 To Len(St) - Len(SubSt) + 1
If Mid(St, p, Len(SubSt)) = SubSt Then
FindPos = p
Exit Function
End If
Next p
End If
End Function
Sub DefineCurrentFolderPathForExcelFile_Sample_BeginWithSoftware_COM()
' This Script will define the full current folder path for Excel File
' Provided by BeginWithSoftware.COM
CurrFileFullName = ActiveWorkbook.FullName
SlashPos = Len(CurrFileFullName) - FindPos("\", ReverseString(CurrFileFullName)) + 1
CurrFileShortName = Mid(CurrFileFullName, SlashPos + 1, Len(CurrFileFullName) - SlashPos)
' Resulting String Variable
DefinedFolderPathForExcelFile = Mid(CurrFileFullName, 1, SlashPos)
' Displaying Result in the Immediate Window - Press CTRL+G to view it
Debug.Print "My Current Excel File "; Chr(34); CurrFileShortName; Chr(34); " is in"
Debug.Print Chr(34); DefinedFolderPathForExcelFile; Chr(34)
Debug.Print "folder."
Debug.Print "Done."
End Sub
' ****************** DefineCurrentFolderPathForExcelFile Script Code End ******************
' ****************** FindMaximumValueInColumn Script Code Start ******************
Sub FindMaximumValueInColumn()
' This Script will find maximum value of number in a column
' Provided by BeginWithSoftware.COM
' Please Enter Worksheet Name
MyWorksheetName = "BeginWithSoftware.Com"
' Please Enter Start Row
StartRow = 2
' Please Enter End Row
EndRow = 10000
' Please Enter Column Number
ScanCol = 1
MaxValue = CDbl(Worksheets(MyWorksheetName).Cells(StartRow, ScanCol).Value)
MaxRow = StartRow
For i = StartRow To EndRow
CurrValue = CDbl(Worksheets(MyWorksheetName).Cells(i, ScanCol).Value)
If CurrValue > MaxValue Then
MaxValue = CurrValue
MaxRow = i
End If
Next i
' Displaying Result in the Immediate Window - Press CTRL+G to view it
Debug.Print "The Maximum Value is "; Chr(34); MaxValue; Chr(34); " is in "; MaxRow; " Row"
Debug.Print "Done."
End Sub
' ****************** FindMaximumValueInColumn Script Code End ******************
' ****************** FindMinimumValueInColumn Script Code Start ******************
Sub FindMinimumValueInColumn()
' This Script will find minimum value of number in a column
' Provided by BeginWithSoftware.COM
' Please Enter Worksheet Name
MyWorksheetName = "BeginWithSoftware.Com"
' Please Enter Start Row
StartRow = 2
' Please Enter End Row
EndRow = 7
' Please Enter Column Number
ScanCol = 1
MinValue = CDbl(Worksheets(MyWorksheetName).Cells(StartRow, ScanCol).Value)
MinRow = StartRow
For i = StartRow To EndRow
CurrValue = CDbl(Worksheets(MyWorksheetName).Cells(i, ScanCol).Value)
If CurrValue < MinValue Then
MinValue = CurrValue
MinRow = i
End If
Next i
' Displaying Result in the Immediate Window - Press CTRL+G to view it
Debug.Print "The Minimum Value is "; Chr(34); MinValue; Chr(34); " is in "; MinRow; " Row"
Debug.Print "Done."
End Sub
' ****************** FindMinimumValueInColumn Script Code End ******************
VBA MyVLOOKUPData Function to solve VLOOKUP errors
VBA JoinCellsTool Function to join (merge) multiple cells into one