Auto Run

Making your macros run automatically when opening your workbook. You can either use the Auto Open method or the Workbook Open method. These macros will display the message "Hello" when you open the workbook.

Sub Auto_Open()
Msgbox "Hello"
End Sub

This code would be located in the module. However if you use the second method, the code must be in the workbook (double click "This Workbook" in the explorer window). Click on the drop down list (that says General) and select Workbook. Click on the drop down list (that says declarations) and select Open.

Private Sub Workbook_Open()
Msgbox "Hello"
End Sub

Create New Excel Worksheet With VBA

The Excel VBA macro below will create a new Excel Worksheet called ‘RawData’ or we can use msgbox to ask for the Worksheet name if needed.

If there is already a Worksheet called RawData, user will be ask whether they want to use the old Worksheet and cancel new Worksheet creation, or delete the old Worksheet and continue creating a new blank Worksheet.

Sub CreateNewWorksheet()

    Dim oSheet As Worksheet, vRet As Variant

    On Error GoTo errHandler

    'creating a new excel worksheet called RawData
    Set oSheet = Worksheets.Add
    With oSheet
        .Name = "RawData"
        .<a title="See also Number of Cells/Rows/Columns With Formula" href="http://office-2all.blogspot.in/">Cells</a>(1.1).Select
        .Activate
    End With
    Exit Sub

errHandler:

    'if error due to duplicate worksheet detected
    If Err.Number = 1004 Then
        'display an options to user
        vRet = MsgBox("Worksheet called 'RawData' is already exist, " & _
            "click yes to continue creating new Worksheet and delete the old one, " & _
            "or click no to go to the old worksheet.", _
            vbOKCancel, "Duplicate Worksheet")

        If vRet = vbOK Then
            'delete the old worksheet
            Application.DisplayAlerts = False
            Worksheets("RawData").Delete
            Application.DisplayAlerts = True

            'rename and activate the new worksheet
            With oSheet
                .Name = "RawData"
                .Cells(1.1).Select
                .Activate
            End With
        Else
            'cancel the operation, delete the new worksheet
            Application.DisplayAlerts = False
            oSheet.Delete
            Application.DisplayAlerts = True
            'activate the old worksheet
            Worksheets("RawData").Activate
        End If

    End If

End Sub

Auto Format Excel Cells with Error Value

With the simple Excel macro below, we can make all cells in active Worksheet that contains Error value in it, like #NULL, #Div/0!, #VALUE!, #Ref, #NAME?, #NUM!, And #N/A, will automatically having cell format that different/stand out among all other cells.

In this example, background color of the cell that contains the error value will automatically change color to red, each time the Excel Worksheet activated.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim errCells As Range

Set errCells = Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
errCells.Interior.Color = 255

Set errCells = Nothing
End Sub


Note that using the Cells.SpeciallCells function, we do not need to perform any looping to get Cells which contains the Error value.

This is just like automating Excel cell conditional formating process. Instead of selecting manually all the cells contains Error value or select all cells and then performing cell conditional format, with above code, we do it automatically using simple Excel VBA macro.

Finding Cell with Minimum/Maximum Value in Active Worksheet

Let say we want to find position of cell containing the minimum/maximum value in current/active Excel worksheet, and then after we found the cell, we will change the cell format to make it stand out before other cells.

The logic is simple, we just need to use Excel MIN function to find the minimum/maximum value on the worksheet, and then using Excel FIND function we will find which cell contain that minimum/ maximum value.

Excel VBA macro implementation of the algorithm above will look like below, change code Application.Min(oRg) into Application.Max(oRg) to find the maximum value instead of minimum value.

Sub FindMinValue()

    Dim oRg As Range, iMin As Variant

    Set oRg = Cells
    'Finding the minimum value
    'change Application.Min(oRg) into Application.Max(oRg) to find the maximum value
    iMin = Application.Min(oRg)

    'Select cell containing the min value
    oRg.Find(What:=iMin, _
        After:=oRg.Range("A1"), _
        LookIn:=xlValues, _
        LookAt:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False _
        ).Select

    'Change selected cell format
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    'Displaying min value info
    With Selection
        MsgBox "Min value : " & iMin & vbCrLf & _
        "Cell position " & vbCrLf & _
        "Row : " & .Row & vbCrLf & _
        "Column : " & .Column
    End With

End Sub

How to get an Acronym using Excel VBA?

Function Acronym(Words As Variant) As String

    Dim aWord() As String, ix As Integer

    aWord = Split(Words.Value, " ")
    For ix = 0 To UBound(aWord)
        Acronym = Acronym & UCase(Left(aWord(ix), 1))
    Next ix

End Function

Excel Extract Cell Comments

Sub CreateCommentsSummary()

Dim rgComments As Range, rgCell As Range, rgOutput As Range, iRow As Integer, iCol As Integer

' get all cells with comment

Set rgComments = ActiveSheet.Cells.SpecialCells(xlCellTypeComments)

' get cell reference where user want to place the summary

Set rgOutput = _

Application.InputBox(Prompt:="Select cell where you want to put the comments summary", _

Title:="Comments Summary", Type:=8)

iRow = rgOutput.Row

iCol = rgOutput.Column

' read each cell with comment and build the summary

For Each rgCell In rgComments

Cells(iRow, iCol) = rgCell.Address    ' print cell address

Cells(iRow, iCol + 1) = rgCell.Value    ' print cell value

Cells(iRow, iCol + 2) = rgCell.Comment.Text    'print cell comment text

iRow = iRow + 1

Next rgCell

End Sub

Write To MySQL database PHP

To be able to write data to a database and in this case a MySQL database is an efficient way of automating tasks that normally is very time consuming. This VBA Macro code writes new data to am existing MySQL database.

Explanation

The VBA Macro code useful for updating MySQL databases for example if you have website that is developed in PHP the standard database to use is MySQL. In order to make the connection between excel and MySQL you need an ODBC connector for the latest driver check out mysql.com. In the attached excel file available at the bottom of this page there are columns in the file where you add field names. Not all field names need to be added just the ones you are going to write to. The first id field always needs to be there. Fill in data regarding, database name, server name, user id, password and name of table. Add the field names and beneath the data you are going to write to the database. Push the button and if you have installed the ODBC driver correctly and set up the MySQL database correctly you will start writing data to your MySQL database. Enjoy!

Code

Sub WriteToMySQLDatabase()

' For detailed description visit http://www.vbaexcel.eu/

Dim rs As ADODB.Recordset
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim Password As String
Dim SQLStr As String
Dim User_ID As String
Set rs = New ADODB.Recordset
       
Server_Name = Range("e4").Value             ' IP number or servername
Database_Name = Range("e1").Value         ' Name of database
User_ID = Range("h1").Value                      'id user or username
Password = Range("e3").Value                    'Password
Tabellen = Range("e2").Value                     ' Name of table to write to
       
rad = 0
While Range("a6").Offset(rad, 0).Value <> tom
    TextStrang = tom
    kolumn = 0
    While Range("A5").Offset(0, kolumn).Value <> tom
        If kolumn = 0 Then TextStrang = TextStrang & Cells(5, 1) & " = '" & Cells(6 + rad, 1)
        If kolumn <> 0 Then TextStrang = TextStrang & "', " & Cells(5, 1 + kolumn) & " = '" & Cells(6 + rad, 1 + kolumn)
        kolumn = kolumn + 1
    Wend
    TextStrang = TextStrang & "'"
    SQLStr = "INSERT INTO " & Tabellen & " SET " & TextStrang
    Set Cn = New ADODB.Connection
    Cn.Open "Driver={MySQL ODBC 3.51 Driver};Server=" & Server_Name & ";Database=" & Database_Name & _
    ";Uid=" & User_ID & ";Pwd=" & Password & ";"
    Cn.Execute SQLStr
    rad = rad + 1
Wend

Set rs = Nothing
Cn.Close
Set Cn = Nothing

End Sub