Convert month from numeric to alphabet

Here is how to convert month from number to text. For example, from 07 to July..

• We have to use date() function to help this conversion.
• In cell A1, cell value = 7
• In cell A2, type this function "=DATE(2012,A1,1)" -> this is for change text in cell A1 to date data type by adding day 1th and year 2012
• For convertion, we will use text() function to change month to format which we want
• In cell A3, type this function "=TEXT(A2, "mmm")" -> to change to Jul
• Display in cell A3 will be "Jul"
• If we need "JUL", type upper() function before text() in cell A3 -> "=UPPER(TEXT(A2, "mmm"))"
• We can change format instead of "mmm" to any which we want such as
• "mmm." -> this will show the abbrevation of month name with dot ex. "Jul."
• "mmmm" -> this will show full format of much ex. "July"
• "mmmmm" -> this will show the first alphabet of month ex. "J"

Convert Number to Text

Here are how to convert the existing number to text format in a cell.

1. At the cell, select Format Cells -> tab Number -> select Category = Text
2. At the other cell, type formula =TEXT(X,"0") -> X is refer to the cell which we want to change format, "0" = format text. After that copy this cell and then paste value to the original cell.
3. At the cell, select Data -> Text to Columns -> In the Wizard select Original data type = Delimited -> Next -> Wizard step 2 uncheck all Delimiters -> Next -> Wizard step 3 set Column data format = Text -> Finish

Excel Add-in (.xla, *.xlam)

To distribute the Excel function or procedure to user by keep it with Microsoft Excel program without opening the Excel file with function. Excel Add-in is a good choice, first, we have to convert our function to add-in and then install it in Microsoft Excel.

1. To create the Excel Add-in, this is simply save your workbook with macro in it and then save the Workbook as an Add-In (*.xla or *.xlam) in any path.

2. You can add a command to call the function from the ribbon by adding this code in the Workbook (Workbook_AddInInstall and Workbook_AddinUninstall), then save your Add-in file.

 
Option Explicit

Private Sub Workbook_AddInInstall()
    Dim cmbBar As CommandBar
    Dim cmbControl As CommandBarControl
     
    On Error Resume Next 'Just in case
    'Delete any existing menu item that may have been left.
    Application.CommandBars("Worksheet Menu Bar").Controls("Test").Delete 'Test is name of control to show on ribbon
     
    Set cmbBar = Application.CommandBars("Worksheet Menu Bar")
    Set cmbControl = cmbBar.Controls.Add(Type:=msoControlPopup) 'adds a menu item to the Menu Bar
    With cmbControl
        .Caption = "Test" 'names the menu item
        With .Controls.Add(Type:=msoControlButton) 'adds a dropdown button to the menu item
            .Caption = "Test Excel Add-in 1" 'adds a description to the menu item
            .OnAction = "module1.Test1" 'runs the specified macro
            .FaceId = 59 'assigns an icon to the dropdown
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Test Excel Add-in 2"
            .OnAction = "Module2.Test2"
            .FaceId = 64
        End With
    End With
    
    On Error GoTo 0
End Sub

Private Sub Workbook_AddinUninstall()
    
On Error Resume Next 'In case it has already gone.
    Application.CommandBars("Worksheet Menu Bar").Controls("Test").Delete
    On Error GoTo 0
End Sub

3. Install this Add-in to Microsoft Excel by follow this instruction
   3.1 Go to Excel Options > Add-Ins to open the Add-Ins dialog
   3.2 In this dialog, go to Manage Excel Add-ins > click Go...
   3.3 Browse to your Add-in from item 2 > OK
   3.4 Back to Add-Ins dialog > OK
   3.5 Excel Add-in is already installed to Microsoft Excel with the command bar to run macros in this Add-in

Register DLL and Reg file with Excel VBA

Here is a function to register DLL or OCX components

 
Public Sub RegisterComponent(sFilename As String, Optional bUnRegister As Boolean = False, Optional bHideResults As Boolean = True)
    If Len(Dir$(sFilename)) = 0 Then
        'File is missing
        MsgBox "Unable to locate file "" & sFileName & """, vbCritical
    Else
        If bUnRegister Then
            'Unregister a component
            If bHideResults Then
                'Hide results
                Shell "regsvr32 /s /u " & """" & sFilename & """"
            Else
                'Show results
                Shell "regsvr32 /u " & """" & sFilename & """"
            End If
        Else
            'Register a component
            If bHideResults Then
                'Hide results
                Shell "regsvr32 /s " & """" & sFilename & """"
            Else
                'Show results
                Shell "regsvr32 " & """" & sFilename & """"
            End If
        End If
    End If
End Sub

For example :

 
Sub test()
    RegisterComponent ("c:\test.dll")
End Sub

Here is a function to export a section of registry to .reg file

Public Sub RegeditExport(sKey As String, sFilename As String)
    Shell "regedit.exe /s /e " & Chr(34) & sFilename & Chr(34) & " " & Chr(34) & sKey & Chr(34), vbHide
End Sub

Here is a function to import windows registry file (.reg file) to the registry

 
Public Sub RegeditImport(sFilename As String)
    Shell "regedit.exe /s /c " & Chr(34) & sFilename & Chr(34), vbHide
End Sub

For example:

 
Sub test()
    RegeditImport "C:\test.reg"
End Sub

Get or set computer name function

Here is a function to get or set the computer name

 
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpbuffer As String, nsize As Long) As Long
Private Declare Function SetComputerName Lib "kernel32" Alias "SetComputerNameA" (ByVal lpComputerName As String) As Long

'Purpose     :  Returns the name of the local machine/computer
'Inputs      :  N/A
'Outputs     :  Returns the name of the local machine
'Notes       :  Uses a private static for speed


Public Function MachineName() As String
    Dim lRet As Long
    Dim lMaxLen As Long
    Static ssMachineName As String
    
    If Len(ssMachineName) = 0 Then
        lMaxLen = 100
        ssMachineName = String$(lMaxLen, vbNullChar)
        lRet = GetComputerName(ssMachineName, lMaxLen)
        ssMachineName = Left$(ssMachineName, lMaxLen)
    End If
    MachineName = ssMachineName
End Function

'Purpose     :  Sets the name of the local machine/computer
'Inputs      :  sName           The new name of the local machine/computer
'Outputs     :  Returns True if failed to change local machine name


Function MachineNameSet(sName As String) As Boolean
    MachineNameSet = IIf(SetComputerName(sName & vbNullChar) = 0, False, True)
End Function

Credit : http://www.visualbasic.happycodings.com/Applications-VBA/code23.html

Read ini value

Function for read a value of each key from ini file.

 
Public Function ReadIniValue(ByVal INIpath As String, ByVal KEY As String, ByVal Variable As String) As String  
 Dim NF As Integer  
 Dim temp As String  
 Dim LcaseTemp As String  
 Dim ReadyToRead As Boolean  
 AssignVariables:  
     NF = FreeFile  
     ReadIniValue = ""  
     KEY = "[" & LCase$(KEY) & "]"  
     Variable = LCase$(Variable)  
 EnsureFileExists:  
   If Dir(INIpath) = "" Then  
    MsgBox " No file you are tring to read ", vbOKOnly, "Error"  
    Exit Function  
   End If  
   'Open INIpath For Binary As NF  
   ' Close NF  
   'SetAttr INIpath, vbArchive  
 LoadFile:  
   Open INIpath For Input As NF  
   While Not EOF(NF)  
      Line Input #NF, temp  
      LcaseTemp = LCase$(Trim(temp))  
      If InStr(LcaseTemp, "[") <> 0 Then ReadyToRead = False  
      If LcaseTemp = KEY Then ReadyToRead = True  
      If InStr(LcaseTemp, "[") = 0 And ReadyToRead = True Then  
       If InStr(LcaseTemp, Variable & "=") = 1 Then  
         ReadIniValue = Mid$(temp, 1 + Len(Variable & "="))  
         Close NF: Exit Function  
         End If  
      End If  
   Wend  
   Close NF  
 End Function  

Split function

Split function is used for separating any string to substring by using a specified delimiter.

Syntax
Split(expression[, delimiter[, limit[, compare]]])
For example:
Public Function SplitText(str, n, delim)
'Returns the nth element from a string,
'using a specified separator character
Dim x As Variant    x = Split(str, delim)
    If n > 0 And n - 1 <= UBound(x) Then
       SplitText= x(n - 1)
    Else       SplitText= ""
    End If
End Function

Example: Range("A1") = test1,test2,test3

Sub test()
Dim result1 As String
Dim result2 As String
Dim result3 As String   
   result1 = SplitText(Range("A1").Value, 1, ",") 'result = test1
   result2 = SplitText(Range("A1").Value, 2, ",") 'result = test2
   result3 = SplitText(Range("A1").Value, 3, ",") 'result = test3
End Sub

Open another program with Excel VBA

To open another program by using Excel VBA, we can use function "shell" to open it.

Syntax
Shell(pathname[,windowstyle])

pathname
Required; Variant (String). Name of the program to execute and any required arguments or command-line switches; may include directory or folder and drive.

The windowstyle named argument has these values:

Constant	Value	Description
vbHide	0	Window is hidden and focus is passed to the hidden window. The vbHide constant is not applicable on Macintosh platforms.
vbNormalFocus	1	Window has focus and is restored to its original size and position.
vbMinimizedFocus	2	Window is displayed as an icon with focus.
vbMaximizedFocus	3	Window is maximized with focus.
vbNormalNoFocus	4	Window is restored to its most recent size and position. The currently active window remains active.
vbMinimizedNoFocus	6	Window is displayed as an icon. The currently active window remains active.

Here is an example to open Internet Explorer:

-----------------------------------------------------------------------------------------------------------------------

Sub test()

'To search "test" with google

Dim ReturnValue As Double

   ReturnValue = Shell("C:\Program Files\Internet Explorer\iexplore.exe http://www.google.com", 1)
   Application.Wait (Now + TimeValue("0:00:01")) 'wait 1 seconds

   AppActivate ReturnValue

   Application.SendKeys "test" 'search "test" with google

   SendKeys "~", True 'enter

End Sub

-----------------------------------------------------------------------------------------------------------------------

SendKeys in VBA

To send text to Excel by using command in Excel marco (VBA), we can use method "SendKeys" to send it. SendKeys is a method to capture key strokes in VBA.

Syntax
expression .SendKeys(Keys, Wait)
expression A variable that represents an Application object.

Name	Required/Optional	Data Type	Description
Keys	Required	Variant	The key or key combination you want to send to the application, as text.
Wait	Optional	Variant	True to have Microsoft Excel wait for the keys to be processed before returning control to the macro. False (or omitted) to continue running the macro without waiting for the keys to be processed.

Key	Code
BACKSPACE	{BACKSPACE} or {BS}
BREAK	{BREAK}
CAPS LOCK	{CAPSLOCK}
CLEAR	{CLEAR}
DELETE or DEL	{DELETE} or {DEL}
DOWN ARROW	{DOWN}
END	{END}
ENTER (numeric keypad)	{ENTER}
ENTER	~ (tilde)
ESC	{ESCAPE} or {ESC}
HELP	{HELP}
HOME	{HOME}
INS	{INSERT}
LEFT ARROW	{LEFT}
NUM LOCK	{NUMLOCK}
PAGE DOWN	{PGDN}
PAGE UP	{PGUP}
RETURN	{RETURN}
RIGHT ARROW	{RIGHT}
SCROLL LOCK	{SCROLLLOCK}
TAB	{TAB}
UP ARROW	{UP}
F1 through F15	{F1} through {F15}

You can also specify keys combined with SHIFT and/or CTRL and/or ALT. To specify a key combined with another key or keys, use the following table.

To combine a key with	Precede the key code with
SHIFT	+ (plus sign)
CTRL	^ (caret)
ALT	% (percent sign)

Here is an example to use SendKeys

-------------------------------------------------------------------------------------------------------------------------
Sub Test()
   Application.SendKeys "{HOME}", True 'send HOME to the Excel and wait for the keys to be processed
   Application.SendKeys "Test" 'send word "Test" to the Excel with default value (without true/false) and not wait for the keys to be processed
End Sub
-------------------------------------------------------------------------------------------------------------------------

Example of mouse click by Excel VBA

This is an example to control mouse to click on the specify position by using Windows API function. First, declare the following in the code 

Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cbuttons As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As pointapi) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Const MOUSEEVENTF_LEFTDOWN As Integer = 2
Const MOUSEEVENTF_LEFTUP As Integer = 4
Const MOUSEEVENTF_RIGHTDOWN As Integer = 8
Const MOUSEEVENTF_RIGHTUP As Integer = 16

Private Type pointapi
    X  As Long
    Y  As Long
End Type

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
------------------------------------------------------------------

Here is an example
Sub test()
   SetCursorPos 200, 200 'set mouse position at 200, 200
   Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0) 'click left mouse
   Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0) 'release left mouse
End Sub

Convert dd:hh:mm:ss to hour or second

Public Function ConvertToHR(str As String) As String

'dd:hh:mm:ss
Dim d, h As Integer
Dim tmp, m, s As String

If str = "" Then
   ConvertToHR = "no data"
   Exit Function
End If
d = CInt(Mid(str, 1, 2))
h = CInt(Mid(str, 4, 2))
m = Mid(str, 7, 2)
s = Mid(str, 10, 2)
'tmp = CStr((d * 24) + h) & "." & m & "." & s
tmp = CStr((d * 24) + h)
ConvertToHR = tmp

End Function




Public Function ConvertToSec(str As String) As String
'dd:hh:mm:ss
Dim d, h As Long
Dim tmp, m, s As String

If str = "" Then
   ConvertToSec = "no data"
   Exit Function
End If
d = CInt(Mid(str, 1, 2))
h = CInt(Mid(str, 4, 2))
m = Mid(str, 7, 2)
s = Mid(str, 10, 2)
'tmp = CStr((d * 24) + h) & "." & m & "." & s
tmp = CStr((((d * 24) + h) * 60 + m) * 60 + s)
ConvertToSec = tmp

End Function

Array sorting procedure

'------------------------------------------------------------------------
Private Sub SortArray(arr() As Integer)
'------------------------------------------------------------------------
'This sub uses the Bubble Sort algorithm to sort an array of integers.

Dim lngX As Long
Dim lngY As Long
Dim tmp As Integer

For lngX = LBound(arr) To (UBound(arr) - 1)
   For lngY = LBound(arr) To (UBound(arr) - 1)
      If arr(lngY) > arr(lngY + 1) Then
         'exchange the items
         tmp = arr(lngY)
         arr(lngY) = arr(lngY + 1)
         arr(lngY + 1) = tmp
      End If
   Next lngY
Next lngX

End Sub

Key Enter in Excel VBA

To check the KeyPress event of "Enter" in user form.

A KeyPress event does not occur under the following conditions:
Pressing TAB.
Pressing ENTER.
Pressing an arrow key.
When a keystroke causes the focus to move from one control to another.
 
Therefore, if we would like to use an event Enter in Excel VBA, we should do as in the followings
 
---------------------------------------------------------------------------------------
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If KeyCode = 13 Then 'we can use either 13 or vbKeyReturn
   MsgBox "This messagebox will show after press Enter!"
End If

End Sub
---------------------------------------------------------------------------------------


Below code is not working in Excel VBA
---------------------------------------------------------------------------------------

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If KeyAscii = 13 Then
   MsgBox "This procedure is not work for checking Enter event in Excel VBA!"
End If

End Sub
---------------------------------------------------------------------------------------

List files in specific path

Sub FileList()

'*** List all files in specific path and pattern ***'
'*** in Excel file start from cell A1 of sheet1 ***'
'*** using GetFileList and IsArray function ***'

Dim p As String
Dim X As Variant


p = "C:\test\*.xls" 'select only *.xls pattern
X = GetFileList(p)

Select Case IsArray(X)
   Case True 'files found
      'MsgBox UBound(x)
      Sheets("Sheet1").Range("A:A").Clear
      For i = LBound(X) To UBound(X)
         Sheets("Sheet1").Cells(i, 1).Value = X(i)
      Next i
   Case False 'no files found
      MsgBox "No matching files"
End Select


End Sub

Check existing value in array

Function InSArray(ByRef vArray() As String, ByVal vValue As String) As Boolean

'***Return true, if found this value in array***'
'***Return false, if not found this value in array***'

Dim i As Long


For i = LBound(vArray) To UBound(vArray)
   If vArray(i) = vValue Then
      InSArray = True
      Exit Function
   End If
Next i

InSArray = False

End Function

Get user name function

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
---------------------------------------------------------

Public Function CurrentUser() As String
'*********************************************************
'* Function to get the current logged on user in windows *
'*********************************************************


Dim strBuff As String * 255
Dim X As Long

CurrentUser = ""
X = GetUserName(strBuff, Len(strBuff) - 1)
If X > 0 Then
   'Look for Null Character, usually included
   X = InStr(strBuff, vbNullChar)
   'Trim off buffered spaces too
   If X > 0 Then
      CurrentUser = UCase(Left$(strBuff, X - 1)) 'UCase is optional
   Else
      CurrentUser = UCase(Left$(strBuff, X))
   End If
End If


End Function