Improve Macro Performance

Increase Macro Speed

Sub Speed_Up_Performance()

Set_Performance_Options

' Use Early Binding Instead of late binding

' Do not use Variant if you can use Long, String data types

' If you want to loop through the documents/workbooks use For each
For Each Doc In Documents
' Do something
Next Doc

ReSet_Performance_Options

End Sub



Function Set_Performance_Options()

' If an updated cell value is necessary for the macro. Then either do not use this or used forced calculation using calculate method
Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

End Function

Function ReSet_Performance_Options()

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Function

' ScreenUpdating, Calculation, Early Binding, late binding, Speedup VBA Performance, Optimize VBA Code, Visual Basic Code Optimization

Generic Function to Check if Application is Running

Check if Instance of Application is Running


' Change the sApp Variable to check the Application you needed



Sub Check_If_Application_Is_Open()

'Check if Instance of MS Word is Running in the machine

sApp = "Word.Application"
If IsAppRunning(sApp) = True Then
MsgBox "Application is Running"
Else
MsgBox "Application is NOT Running. Let me create my own"
' Create a new instance
Set oApp = CreateObject(, sApp)
End If


End Sub

' Generalized Function to Check if an Instance of Application is running in the machine
Function IsAppRunning(ByVal sAppName) As Boolean
Dim oApp As Object
On Error Resume Next
Set oApp = GetObject(, sAppName)
If Not oApp Is Nothing Then
Set oApp = Nothing
IsAppRunning = True
End If
End Function

' Generic Function to Check if Application is Running, Visual Basic GetObject, VBA GetObject, VB6 GetObject

VBA Function to Check File Existence

This Visual Basic Function can be used to check if a file exists under a specific directory

Sub Check_If_File_Exists()

' To Check if a file is present, give the file name and omit the second argument
sFile = "c:\Temp\Test.txt"
If File_Exists(sFile) = True Then
MsgBox sFile & " exist"
Else
MsgBox sFile & " does not exist"
End If

' To Check if a directory is present, give the directory name and make the second argument = True
sDir = "d:\VBADudExamples\Code"
If File_Exists(sDir, True) = True Then
MsgBox "Directory " & sDir & " exist"
Else
MsgBox "Directory " & sDir & " does not exist"
End If


End Sub
' Keywords : Check Directory Existence, VBA Dir Function, Visual Basic Dir Function, Dir$ Function Example, VB File Exists, VBA Check File Availability


Private Function File_Exists(ByVal sPathName As String, Optional Directory As Boolean) As Boolean

'Returns True if the passed sPathName exist
'Otherwise returns False
On Error Resume Next
If sPathName <> "" Then

If IsMissing(Directory) Or Directory = False Then

File_Exists = (Dir$(sPathName) <> "")
Else

File_Exists = (Dir$(sPathName, vbDirectory) <> "")
End If

End If
End Function

BlogRankings.com

All-Blogs.net directory

Visual Basic Function to Get Temporary Folder

Windows API Function to Get Temporary Folder

Private Declare Function GetTempPath Lib "kernel32" Alias _
"GetTempPathA" (ByVal nBufferLength As Long, ByVal _
lpBuffer As String) As Long

Const MAX_PATH = 260

' This function uses Windows API GetTempPath to get the temporary folder

Sub Get_Temporary_Folder()

sTempFolder = GetTmpPath

End Sub

' Keywords: Get Temporary Folder, Temporary Folder Visual Basic Code, VB Function Get Temp Folder, VBA Temporary Folder, VB6 Temporary Folder, GetTempPath, Windows API Functions


Private Function GetTmpPath()

Dim sFolder As String ' Name of the folder
Dim lRet As Long ' Return Value

sFolder = String(MAX_PATH, 0)
lRet = GetTempPath(MAX_PATH, sFolder)

If lRet <> 0 Then
GetTmpPath = Left(sFolder, InStr(sFolder, _
Chr(0)) - 1)
Else
GetTmpPath = vbNullString
End If

End Function

This function can be used to identify the Temporary folders for Windows XP kind of OS, where each login will have its own temp folder

VBA Email Automation / VBA Mail Automation

VBA Email Automation / VBA Mail Automation

Sub Send_Mail_From_Excel()


' This is an automatic mail program. It takes the mail Id's from activeworkbook and uses outlook object to send mail
' The format of the workbook should be as follows
' 1. Data Should start from Row 2 - Sheet 1
' 2. Salutation in Col 1 -e.g., Mr, Ms, Dr etc
' 3. Name in Col 2 -e.g., Sheetal
' 4. Email in Col 4 -e.g., sheetal@vbadud.com
' Program will loop through the entire sheet and send mails to all


Dim oXlWkBk As Excel.Workbook ' Excel Work Book Object

Dim oOLApp As Outlook.Application
Dim oOLMail As MailItem

Dim lRow As Long
Dim olMailItem

Dim sMailID As String
Dim sSalutation As String
Dim sName As String
Dim sDetails As String
Dim sSubject As String
On Error GoTo Err_Trap


Set oXlWkBk = ActiveWorkbook

If oXlWkBk.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Row < oolapp =" New" lrow =" 2" oolmail =" oOLApp.CreateItem(olMailItem)" ssalutation =" oXlWkBk.Sheets(1).Cells(lRow," sname =" oXlWkBk.Sheets(1).Cells(lRow," sdetails = "Hi"> 0 And LenB(Trim$(sSalutation)) <> 0) Then
sDetails = sSalutation & " " & sName
ElseIf LenB(Trim$(sName)) <> 0 Then
sDetails = sName
Else
sDetails = "Hi"
End If
sDetails = sDetails & vbNewLine & vbNewLine

sMailID = Trim$(oXlWkBk.Sheets(1).Cells(lRow, 3).Value)

' --- Validate EMail ID
If InStr(1, sMailID, "@") = 0 Then
GoTo TakeNextRow
End If

' Create Mail
With oOLMail
.To = sMailID
.Subject = sSubject
.Body = sDetails & "This is a test mail from VBA Tips & Tricks (http://vbadud.blogspot.com/)"
End With

oOLMail.Send

TakeNextRow:
Next lRow

oXlWkBk.Close (False)

'--------------------------------------------------------
' Coded by Shasur for http://vbadud.blogspot.com
'--------------------------------------------------------


Destroy_Objects:
'Destroy Objects
If Not oOLApp Is Nothing Then Set oOLApp = Nothing


Err_Trap:
' Error Handling
If Err <> 0 Then
MsgBox Err.Description, vbInformation, "VBADUD AutoMail"
Err.Clear
GoTo Destroy_Objects
End If

'------------------------------------------------------------------------------------
' Disclaimer: VBA Tips & Tricks (http://vbadud.blogspot.com) publishes this content
' for the intention of sharing technical knowledge. Any misuse of this program (e.g., spamming)
' will not be our responsibility.
'------------------------------------------------------------------------------------


End Sub


'Keywords: 'Keywords: Automate Email, VBA Email, Send Email from Excel, VBA Mail automation, Mail Automation, Outlook VBA, Automate Outlook, Send Mail from Outlook, Link Excel with Outlook,Microsoft Outlook Mail Automation, Excel VBA Mail, MAPI, Send Multiple eMails





If you want to try the same using Lotus Notes refer http://vbadud.blogspot.com/2007/10/automate-lotus-notes-email-using-visual.html

SaveAs Dialog - Controlled Save

SaveAs Dialog - Controlled Save



Sub Save_File_Dialog()

Dim sFName

' Can be used as Excel SaveAs Dialog

'----------------------------
' Coded for http://vbadud.blogspot.com
'----------------------------


sFName = Application.GetSaveAsFilename
If sFName = False Then
MsgBox "Enter a File Name Please!!!"
End If

' Display Default FileName in the SaveAs Dialog/Save Dialog Box
sFName = Application.GetSaveAsFilename("VBADud_Example.xls")

' Force File Type during Save
sFName = Application.GetSaveAsFilename("VBADud_Example.xls", "Excel files (*.xls), *.xls")


End Sub

This method displays the standard Save As dialog box and gets a file name from the user without actually saving any files

This does not save the file...


See also :

Excel VBA - 1004 -- The file could not be accessed

Save and Reopen all Workbooks (Excel VBA)

Save copy of the workbook

SaveAs Dialog - Controlled Save

Save RTF document as word

Open Excel Files - Open Dialog - GetOpenFilename Method

Open Excel Files - Open Dialog - GetOpenFilename Method


The GetOpenFilename Method is a cousin to the CommonDialog. Some of the CommonDialog's tasks can he done with this method



GetOpenFilename Method (Displays the standard Open dialog box and gets a file name from the user without actually opening any files.)


Sub Open_Excel_File_Thru_VBA()

'----------------------------
' Coded for http://vbadud.blogspot.com
'----------------------------

Dim arTemp() As Variant

Dim lRet

On Error GoTo Err_Clr

'Default method Uses Open Dialog To Show the Files
lRet = Application.GetOpenFilename

'Select Only Excel Files - One File at A Time
lRet = Application.GetOpenFilename("Excel files (*.xls), *.xls")
If lRet = False Then
MsgBox "Select a File Please!!!"
End If

'Select Multiple Files - Get Multiple Files as Input
' An array can be used to get the multiple excel files selected by user
arTemp = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls", MultiSelect:=True)
If UBound(arTemp) = 0 Then
MsgBox "Select a File Please!!!"
End If


Err_Clr:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub



Excel VBA, GetOpenFilename Method, Show Dialog, , Show Open Dialog Box

Browse a Folder / Select a Folder Thru Shell

Browse a Folder / Select a Folder Thru Shell

Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Here let us use the above shell functions to open the browse directory dialog

Sub Show_BrowseDirectory_Dialog()

' BrowseForFolder
' SHBrowseForFolder API Function Example

Dim dirInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

' Set Default Root folder = Desktop
dirInfo.pidlRoot = 0&

dirInfo.lpszTitle = "Browse directory!"

' Type of directory
dirInfo.ulFlags = &H1

' Show the Browse Dialog
x = SHBrowseForFolder(dirInfo)

' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
MsgBox "You have selected :=" & Left(path, pos - 1)
Else
MsgBox "Browse a Directory..."
Show_BrowseDirectory_Dialog
End If

End Sub

SHBrowseForFolder Function displays a dialog box enabling the user to select a Shell folder

Add Controls To Tools Menu

Creating Custom Office Menus and Toolbars

Sub Call_Add_Control_To_ToolsMenu()

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------
Add_Control_To_ToolsMenu "Sample", "Donot_Fire_Events"

End Sub

you need to have a sub Donot_Fire_Events to test this

Function Add_Control_To_ToolsMenu(ByVal sControlName As String, ByVal sMacroName As String)

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

On Error GoTo DisplayErr

Dim ctlMenu As CommandBarControl
Dim ctlCommand As CommandBarControl

Set ctlMenu = Application.CommandBars.FindControl(ID:=30007)

If ctlMenu Is Nothing Then Exit Function

Set ctlCommand = ctlMenu.Controls.Add
ctlCommand.Caption = sControlName
ctlCommand.OnAction = sMacroName

DisplayErr:
If Err <> 0 Then
MsgBox Err.Description
Err.Clear
End If


Creating Custom Office Menus and Toolbars, Programming Microsoft Office Command Bars, CommandBars Property, Creating an Excel Add-in, Disable command bars and controls, Change the availability for the CommandBars using VBA, Delete/ hide a custom command bar

Add a new menu item to the Tools menu, Adding Menu Items, Add Command to Tools menu, Dynamic Addition of command to tools menu. Adding Command Button to Tools, Adding to Tools menu


End Function

Deleting Custom Office Menus and Toolbars

Deleting Custom Office Menus and Toolbars

Function delete_Control_from_ToolsMenu(ByVal sControlName As String)

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

On Error GoTo DisplayErr

Dim ctlMenu As CommandBarControl
Dim ctlCommand As CommandBarControl

Set ctlMenu = Application.CommandBars.FindControl(ID:=30007)

If ctlMenu Is Nothing Then Exit Function

Set ctlCommand = ctlMenu.Controls(sControlName)

If Not ctlCommand Is Nothing Then ctlCommand.Delete

DisplayErr:
If Err <> 0 Then
MsgBox Err.Description
Err.Clear
End If

End Function

Creating Custom Office Menus and Toolbars, Programming Microsoft Office Command Bars, CommandBars Property, Creating an Excel Add-in, Disable command bars and controls, Change the availability for the CommandBars using VBA, Delete/ hide a custom command bar

enable popup menu

Sub Enable_Right_Click()

You can use the following function to enable mouse click - Right Click

This will enable popup menu



' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

' This will enable mouse right click on worksheets

Application.CommandBars("Cell").Enabled = True

End Sub

Disable Right Click

You can use the following function to disable mouse click. Right Click

This will disable popup menu

Sub Disable_Right_Click()

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

' This will disable mouse right click on worksheets

Application.CommandBars("Cell").Enabled = False

End Sub


D

Add Control To PopupMenu

Add Control To PopupMenu

Use this function to add the control to the popup menu

Function Add_Control_To_PopupMenu(ByVal sControlName As String, ByVal sMacroName As String)

On Error GoTo DisplayErr

Dim ctlCB As CommandBar
Dim ctlMenu As CommandBarControl
Dim ctlCommand As CommandBarControl

Set ctlCB = Application.CommandBars("Cell")

If ctlCB Is Nothing Then Exit Function

Set ctlCommand = ctlCB.Controls.Add
ctlCommand.Caption = sControlName
ctlCommand.OnAction = sMacroName

DisplayErr:
If Err <> 0 Then
MsgBox Err.Description
Err.Clear
End If


'Creating Custom Office Menus and Toolbars, Programming Microsoft Office Command Bars, CommandBars Property, Creating an Excel Add-in, Disable command bars and controls, Change the availability for the CommandBars using VBA, Delete/ hide a custom command bar

End Function
Sub Call_Add_Control_To_PopupMenu()

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

Add_Control_To_PopupMenu "Sample", "Donot_Fire_Events"

End Sub

Add a new menu item to the Popup menu, Adding Menu Items, Add Command to Popup menu, , Dynamic Addition of command to Popup menu. Adding Command Button to Popup, Adding to Popup menu

Delete Control From PopupMenu

Delete Control From PopupMenu (Right Click Menu)

Function Delete_Control_From_PopupMenu(ByVal sControlName As String, ByVal sMacroName As String)

On Error GoTo DisplayErr

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

Dim ctlCB As CommandBar
Dim ctlCommand As CommandBarControl

Set ctlCB = Application.CommandBars("Cell")

If ctlCB Is Nothing Then Exit Function

Set ctlCommand = ctlCB.Controls(sControlName)

If Not ctlCommand Is Nothing Then ctlCommand.Delete

DisplayErr:
If Err <> 0 Then
MsgBox Err.Description
Err.Clear
Resume Next
End If


'Creating Custom Office Menus and Toolbars, Programming Microsoft Office Command Bars, CommandBars Property, Creating an Excel Add-in, Disable command bars and controls, Change the availability for the CommandBars using VBA, Delete/ hide a custom command bar

End Function
Sub Call_Delete_Control_From_PopupMenu()

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

Delete_Control_From_PopupMenu "Sample", "Donot_Fire_Events"

End Sub

Add a new menu item to the Tools menu, Adding Menu Items, Add Command to Tools menu, , Dynamic Addition of command to tools menu. Adding Command Button to Tools, Adding to Tools menu

Using VBA's IsError Function

' Using VBA's IsError Function
For Each c1 In ActiveSheet.UsedRange

If IsError(c1) Then
' Coded By Shasur

MsgBox "Error in " & c1.Address

End If
Next

End Sub

Excel Dialog Sheets

Here you have Kathy (and all programmers who need to work on the legacy Excel VBA code). Dialog sheets

Sub The_Good_Old_Dialog_Boxes()

ActiveDialog.Focus = "EditBox1"

Application.ThisWorkbook.DialogSheets("Dialog1").Buttons("cmdOK").Enabled = False

ActiveDialog.EditBoxes("EditBox1").Text = vbNullString

End Sub

Insert Dialog Sheet

' Ha ha .. If you haven't used dialog sheets before and wanted to have a feel on it, here we go

Sub Insert_Dialog_Sheet()

ActiveWorkbook.Sheets.Add Type:=xlDialogSheet

End Sub

You will find the sheet getting transformed to a Grid and a userform like control - the dialog sheet. The dialog sheets have been replaced by UserForms in Excel 97

Case in-sensitive comparison

Option Compare Text

If you do not worry about the case in comparisons, then use the Option Compare Text for string comparisons based on a case-insensitive text sort order determined by system's locale
Warning: This cannot be set for procedure level. When set, this will be for the entire module

Sub Option_Compare_Statement_Example()


Dim sStr1 As String ' String 1
Dim sStr2 As String ' String 2

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

sStr1 = "MixedCase"
sStr2 = "mixedcase"


If InStr(1, sStr1, sStr2) Then
MsgBox "Matching!!!"
End If

' ---------------------------------------------------------------
'
' ---------------------------------------------------------------

End Sub

Option Compare Text

If you do not worry about the case in comparisons, then use the Option Compare Text for string comparisons based on a case-insensitive text sort order determined by system's locale
Warning: This cannot be set for procedure level. When set, this will be for the entire module

Sub Option_Compare_Statement_Example()


Dim sStr1 As String ' String 1
Dim sStr2 As String ' String 2

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

sStr1 = "MixedCase"
sStr2 = "mixedcase"


If InStr(1, sStr1, sStr2) Then
MsgBox "Matching!!!"
End If

' ---------------------------------------------------------------
'
' ---------------------------------------------------------------

End Sub

Delete Temporary Files

Sub Delete_Temp_Files_Primitive()

Dim sFileType As String ' Declare the Type of File
Dim sTempDir As String ' Temporary Directory

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

On Error Resume Next

sFileType = "*.tmp"
sTempDir = "c:\windows\Temp\" ' There might be mutiple temp directories (one for each profile) in Windows XP. Modify the code accordingly

Kill sTempDir & sFileType

' ---------------------------------------------------------------
' Delete Temporary Files, Excel VBA, Kill Statement
' ---------------------------------------------------------------

End Sub

Aligning Text Output in Variables

Formatting Report - Formatting Text Files

Sub Aligning_Text_In_Variables()

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

' Aligment of Text in Reports is a pain.. that too if the report is a flat file

' Here are a couple of ways to align

Dim sCharBuff As String
Dim sName As String
Dim sAge As String
Dim sAdd As String
Dim sPrint As String

' Left Alignment
' Example
' Name :
' Age :
' Address :


sCharBuff = "123456789123456789" ' Just for length
sName = "Name"
sAge = "Age"
sAdd = "Address"

sPrint = sCharBuff
LSet sPrint = sName
Debug.Print sPrint & ":"

sPrint = sCharBuff
LSet sPrint = sAge
Debug.Print sPrint & ":"

sPrint = sCharBuff
LSet sPrint = sAdd
Debug.Print sPrint & ":"

' Right Alignment
' Example
' Name:
' Age:
' Address:


sCharBuff = "123456789123456789" ' Just for length
sName = "Name"
sAge = "Age"
sAdd = "Address"

sPrint = sCharBuff
RSet sPrint = sName
Debug.Print sPrint & ":"

sPrint = sCharBuff
RSet sPrint = sAge
Debug.Print sPrint & ":"

sPrint = sCharBuff
RSet sPrint = sAdd
Debug.Print sPrint & ":"


' ---------------------------------------------------------------
' Aligning Text Output in Variables
' ---------------------------------------------------------------


End Sub

Moving Log Files

Sub Naming_Files()

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------
' Programmers use log files to updated the status of the process
' Depending on the output the files are renamed or moved
' Here is a simple function to move and rename files


Name "d:\VBADudExamples\InProgress\Process.log" As "d:\VBADudExamples\Completed\Completed.log"


' ---------------------------------------------------------------
' Moving Log Files, Creating Log Files, Excel VBA, Name Statement
' ---------------------------------------------------------------


End Sub

Run-time Error 55!!! File already open

Run-time Error 55 File already open. This is one of the common error in file handling. It is difficult to avoid if you handle multiple files and use direct file numbers


Sub TextFile_Write_Error()

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------
'


' ------------------------
' Code with Errors
' ------------------------
Open "d:\VBADudExamples\TextFile1.txt" For Output As #1 ' Open file for output.

Print #1, "TextFile1"

Open "d:\VBADudExamples\TextFile2.txt" For Output As #1 ' Open file for output.

Close #1 ' Close file.

Close #1 ' Close file.

' ------------------------
' Workaround for the Errors
' ------------------------
' Use FreeFile to get a file number that is not used

iF1 = FreeFile ' Returns an Integer representing the next file number available for use by the Open statement.
Open "d:\VBADudExamples\TextFile1.txt" For Output As #iF1 ' Open file for output.

Print #iF1, "TextFile1"

iF2 = FreeFile
Open "d:\VBADudExamples\TextFile2.txt" For Output As #iF2 ' Open file for output.

Close #iF2 ' Close file.

Close #iF1 ' Close file.


' ------------------------------------------------
' Excel VBA, Run-time Error 55, File already open
' ------------------------------------------------


End Sub

Spacing in Text Files

Formatting Report , Formatting Text Files, Aligning Text File

For a Neatly Spaced Text File:

Sub EquiSpaced_TextFile()

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

Dim iMaxLength As Integer

iMaxLength = 20

Open "d:\VBADudExamples\TabbedFile.txt" For Output As #1 ' Open file for output.

Print #1, "Name "; Tab(iMaxLength); "Santhosh Prabhakaran"
Print #1, "Place "; Tab(iMaxLength); "Madras"
Print #1, "Designation "; Tab(iMaxLength); "Admin Manager"

Close #1 ' Close file.

' Excel VBA, Write to Text File, Neatly Spaced Text File


End Sub

Get Variable Type

To know the data type of the variable:

Function Get_Variable_Type(myVar)

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

If VarType(myVar) = vbNull Then
MsgBox "Null (no valid data) "
ElseIf VarType(myVar) = vbInteger Then
MsgBox "Integer "
ElseIf VarType(myVar) = vbLong Then
MsgBox "Long integer "
ElseIf VarType(myVar) = vbSingle Then
MsgBox "Single-precision floating-point number "
ElseIf VarType(myVar) = vbDouble Then
MsgBox "Double-precision floating-point number "
ElseIf VarType(myVar) = vbCurrency Then
MsgBox "Currency value "
ElseIf VarType(myVar) = vbDate Then
MsgBox "Date value "
ElseIf VarType(myVar) = vbString Then
MsgBox "String "
ElseIf VarType(myVar) = vbObject Then
MsgBox "Object "
ElseIf VarType(myVar) = vbError Then
MsgBox "Error value "
ElseIf VarType(myVar) = vbBoolean Then
MsgBox "Boolean value "
ElseIf VarType(myVar) = vbVariant Then
MsgBox "Variant (used only with arrays of variants) "
ElseIf VarType(myVar) = vbDataObject Then
MsgBox "A data access object "
ElseIf VarType(myVar) = vbDecimal Then
MsgBox "Decimal value "
ElseIf VarType(myVar) = vbByte Then
MsgBox "Byte value "
ElseIf VarType(myVar) = vbUserDefinedType Then
MsgBox "Variants that contain user-defined types "
ElseIf VarType(myVar) = vbArray Then
MsgBox "Array "
Else
MsgBox VarType(myVar)
End If

' Excel VBA, Visual Basic, Get Variable Type, VarType


End Function

Optional Parameter Example

Function Optional_Param_Example(Optional ByVal vOptionalText1 As Variant, Optional ByVal sOptionalText2 As String)

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

If IsMissing(vOptionalText1) Then
MsgBox "Optional Parameter 1 Missing.."
Else
MsgBox "Optional Parameter 1 Present.."
End If

IsMissing does not work on simple data types (such as Integer or Double) because, unlike Variants, they don't have a provision for a "missing" flag bit.
sOptionalText2 is not reported missing if it is not supplied

If IsMissing(sOptionalText2) Then
MsgBox "Optional Parameter 2 Missing.."
Else
MsgBox "Optional Parameter 2 Present.."
End If

' IsMissing Function, Optional Parameters, IsMissing Doesn't Work

End Function

Show Help From VB

If you have compiled help file (.chm) you can show it using the following

Function Call_Application_Help_MyApp(Optional ByVal vHelpText As Variant)

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

Application.Help "c:\Sample.chm"

' HTML Help, Using Help, Link Application Help with Program
End Function

Technorati Profile

Showing Excel Help

Showing Excel Help

Use this function to show the help; based on helpID

Function Call_Application_Help_Excel(Optional ByVal vHelpText As Variant)

' ---------------------------------------------------------------
' Written By Shanmuga Sundara Raman for http://vbadud.blogspot.com
' ---------------------------------------------------------------

If Val(Application.Version) = 10 Then
Application.Help "XLMAIN10.CHM", vHelpText
Else
Application.Help "XLMAIN9.CHM", vHelpText
End If

' Excel VBA, Using Help, Link Application Help with Program
End Function