Quickly Change Formulas to Values

To change formulas to their values, follow these steps: Select the cells with the formulas that you want to change to values. Point to the border of the selected range, and the pointer should change to a four-headed arrow. Press the right mouse button, and drag the cells slightly to the right. Keep pressing the right mouse button, and drag the cells back to their original location. Release the right mouse button and a shortcut menu will appear. Click on Copy Here as Values Only.

Enter Excel Data in a List

Use Excel's built-in Data Form to make it easier to enter data in a list. It will display a maximum of 32 fields.

1. Select a cell in the list.
2. Choose Data|Form
3. Click the New button, and enter the new record

Note: Fields which contain a formula, such as Total in the Data form shown here, will not have a text box. The formula will be entered and calculated automatically.

For a data form with additional features, you can try John  Walkenbach's Enhanced Data Form. It's free, and allows unlimited fields

Add Line Break in Cell or Formula

Add a line break when typing in a cell Select the cell In the formula bar, click where you want the line break On the keyboard, press Alt + Enter, to add a line break Press Enter, to complete the formula
The cell will automatically be formatted with Wrap Text, and you might need to widen the column.
Add a line break in a formula Select the cell In the formula bar, click in the formula, where you want the line break To add a line break use this character, with the & operator: CHAR(10) Press Enter, to complete the formula
For example, change this formula: ="Total amount is: " & SUM(C1:C6) to this: ="Total amount is: " & CHAR(10) & SUM(C1:C6)
Turn on Wrap Text When you add a line break to a formula, the cell is NOT automatically formatted with Wrap Text, so you might need to turn that feature on. Otherwise, you will see a small box where the line break should be.
To turn on Wrap Text: Select the cell On the Excel Ribbon, click the Home tab In the Alignment group, click Wrap Text.

Excel Data Entry Mouse Shortcuts

Copy Data to Adjacent Cells
Select the cell that contains the data to be copied Point to the Fill Handle -- the black square at the lower right of the selection When the pointer changes to a black plus sign, press the Left mouse button, and drag left, right, up or down, across one or more cells. When finished, release the mouse button. Copy to Adjacent Cells -- with options
Select the cell that contains the data to be copied Point to the Fill Handle -- the black square at the lower right of the selection When the pointer changes to a black plus sign, press the Right mouse button, and drag left, right, up or down, across one or more cells. When finished, release the mouse button. Select one of the options from the shortcut menu Watch this Excel Quick Tips Video for creating a list of dates that are a week apart.

Excel Data Entry Keyboard Shortcuts

Use Shortcut Keys Enter the current Date:  Ctrl + ; Enter the current Time:  Ctrl + Shift + ; Copy Value from cell above:  Ctrl + Shift + ' Copy Formula (exact) from cell above:  Ctrl + ' Copy Formula (relational reference) from cell above:  Ctrl + D

Enter Data in Multiple Cells -- Ctrl + Enter
Select all the cells in which you want to enter the same value or formula Type the value or formula in the active cell Hold the Ctrl key and press Enter

Copy Data to Adjacent Cells
Select the range, starting with the cell that contains the data to be copied Use a shortcut key to fill right or down: Fill Right -- Ctrl + R Fill Down -- Ctrl + D

Convert Trailing Minus Signs Programmatically

In all versions of Excel, you can use the following macro to convert numbers with trailing minus signs.

Sub TrailingMinus()
' = = = = = = = = = = = = = = = =
' Use of CDbl suggested by Peter Surcouf
' Program by Dana DeLouis, dana2@msn.com
' modified by Tom Ogilvy
' = = = = = = = = = = = = = = = =
  Dim rng As Range
  Dim bigrng As Range

  On Error Resume Next
  Set bigrng = Cells _
     .SpecialCells(xlConstants, xlTextValues).Cells
  If bigrng Is Nothing Then Exit Sub

  For Each rng In bigrng.Cells
    If IsNumeric(rng) Then
      rng = CDbl(rng)
    End If
  Next
End Sub

Convert Text to Numbers With VBA

If you frequently convert text to numbers, you can use a macro.
Add a button to an existing toolbar, and attach the macro to that button. Then, select the cells, and click the toolbar button.

Sub ConvertToNumbers() 
  Cells.SpecialCells(xlCellTypeLastCell) _
    .Offset(1, 1).Copy
  Selection.PasteSpecial Paste:=xlPasteValues, _
     Operation:=xlPasteSpecialOperationAdd
  With Selection
     .VerticalAlignment = xlTop
     .WrapText = False
  End With
  Selection.EntireColumn.AutoFit
End Sub 

How to convert text to numbers in Excel

Sub Enter_Values()

 For Each xCell In Selection

 Selection.NumberFormat = "0.00" 'Note: The "0.00" determines the number of decimal places. 

 xCell.Value = xCell.Value

 Next xCell

End Sub

To Search a List for a Specific Record

This code moves down column A to the end of the list:

   Sub Test3()
      Dim x As String
      Dim found As Boolean
      ' Select first line of data.
      Range("A2").Select
      ' Set search variable value.
      x = "test"
      ' Set Boolean variable "found" to false.
      found = False
      ' Set Do loop to stop at empty cell.
      Do Until IsEmpty(ActiveCell)
         ' Check active cell for search value.
         If ActiveCell.Value = x Then
            found = TRUE
            Exit Do
         End If
         ' Step down 1 row from present location.
         ActiveCell.Offset(1, 0).Select
      Loop
   ' Check for found.
      If found = True Then
         Msgbox "Value found in cell " & ActiveCell.Address
      Else
         Msgbox "Value not found"
      End If
   End Sub
    

To Search a Dynamic List or a List with an Unknown Number of Rows

This code moves down column A to the end of the list. (This code assumes that each cell in column A contains an entry until the end.)

   Sub Test2()
      ' Select cell A2, *first line of data*.
      Range("A2").Select
      ' Set Do loop to stop when an empty cell is reached.
      Do Until IsEmpty(ActiveCell)
         ' Insert your code here.
         ' Step down 1 row from present location.
         ActiveCell.Offset(1, 0).Select
      Loop
   End Sub
 

Note:-  If there are empty cells in column A throughout the data, 

modify this code to account for this condition. Make sure that the empty cells are

 a consistent distance apart. For example, if every other cell in column A is

 empty (for example, this situation may occur if every 'record' uses two rows,

 with the second row indented one cell), this loop can be modified as follows:  

      ' Set Do loop to stop when two consecutive empty cells are reached.
      Do Until IsEmpty(ActiveCell) and IsEmpty(ActiveCell.Offset(1, 0))
         ' Insert your code here.
         '
         ' Step down 2 rows from present location.
         ActiveCell.Offset(2, 0).Select
      Loop
    

To Search a List with a Constant, Known Number of Rows

This code moves down column A to the end of the list:  

Sub Test1()
      Dim x As Integer
      ' Set numrows = number of rows of data.
      NumRows = Range("A2", Range("A2").End(xldown)).Rows.Count
      ' Select cell a1.
      Range("A2").Select
      ' Establish "For" loop to loop "numrows" number of times.
      For x = 1 To NumRows
         ' Insert your code here.
         ' Selects cell down 1 row from active cell.
         ActiveCell.Offset(1, 0).Select
      Next
   End Sub

Referring to Cells by Using Index Numbers

You can use the Cells property to refer to a single cell by using row and column index numbers. This property returns a Range object that represents a single cell. In the following example, Cells(6,1) returns cell A6 on Sheet1. The Value property is then set to 10.

Sub EnterValue()
    Worksheets("Sheet1").Cells(6, 1).Value = 10
End Sub
  

The Cells property works well for looping through a range of cells, because you can substitute variables for the index numbers, as shown in the following example.

Sub CycleThrough()
    Dim Counter As Integer
    For Counter = 1 To 20
        Worksheets("Sheet1").Cells(Counter, 3).Value = Counter
    Next Counter
End Sub
  

Referring to Cells and Ranges by Using A1 Notation

ou can refer to a cell or range of cells in the A1 reference style by using the Range property. The following
subroutine changes the format of cells A1:D5 to bold.

Sub FormatRange()
    Workbooks("Book1").Sheets("Sheet1").Range("A1:D5") _
        .Font.Bold = True
End Sub
  

The following table illustrates some A1-style references using the Range property.

Reference	Meaning
Range("A1")	Cell A1
Range("A1:B5")	Cells A1 through B5
Range("C5:D9,G9:H16")	A multiple-area selection
Range("A:A")	Column A
Range("1:1")	Row 1
Range("A:C")	Columns A through C
Range("1:5")	Rows 1 through 5
Range("1:1,3:3,8:8")	Rows 1, 3, and 8
Range("A:A,C:C,F:F")	Columns A, C, and F

Opening an HTML Document in Microsoft Excel

To edit an HTML document in Excel, first open the document by using the Open method. The following example opens the file "C:\Reports\1997_Q4.htm" for editing.

Workbooks.Open Filename:="C:\Reports\1997_Q4.htm"
  

After opening the file, you can customize the appearance, content, browser support, editing support, graphics formats, screen resolution, file organization, and encoding of the HTML document by setting properties of the DefaultWebOptions and WebOptions objects.

Customizing the Web Page

You can customize the appearance, content, browser support, editing support, graphics formats, screen resolution, file organization, and encoding of the HTML document by setting properties of the DefaultWebOptions object and the WebOptions object. The DefaultWebOptions object contains application-level properties. These settings are overridden by any workbook-level property settings that have the same names (these are contained in the WebOptions object).
After setting the attributes, you can use the Publish method to save the workbook, worksheet, chart, range, query table, PivotTable report, print area, or AutoFilter range to a Web page. The following example sets various application-level properties and then sets the AllowPNG property of the active workbook, overriding the application-level default setting. Finally, the example saves the range as "C:\Reports\1998_Q1.htm."

With Application.DefaultWebOptions
    .RelyonVML = True
    .AllowPNG = True
    .PixelsPerInch = 96
End With
With ActiveWorkbook
    .WebOptions.AllowPNG = False
    With .PublishObjects(1)
        .FileName = "C:\Reports\1998_Q1.htm"
        .Publish
    End With
End With
  

You can also save the files directly to a Web server. The following example saves a range to a Web server, giving the Web page the URL address http://example.homepage.com/annualreport.htm.

With ActiveWorkbook
    With .WebOptions
        .RelyonVML = True
        .PixelsPerInch = 96
    End With
    With .PublishObjects(1)
        .FileName = _
        "http://example.homepage.com/annualreport.htm"
        .Publish
    End With
End With
  

Saving Documents as Web Pages

Saving a document as a Web page is the process of creating and saving an HTML file and any supporting files. To do this, use the SaveAs method, as shown in the following example, which saves the active workbook as C:\Reports\myfile.htm.

ActiveWorkbook.SaveAs _
    Filename:="C:\Reports\myfile.htm", _
    FileFormat:=xlHTML
  

Referring to Sheets by Name

You can identify sheets by name using the Worksheets and Charts properties. The following statements activate various sheets in the active workbook.

Worksheets("Sheet1").Activate
Charts("Chart1").Activate
  

DialogSheets("Dialog1").Activate
  

You can use the Sheets property to return a worksheet, chart, module, or dialog sheet; the Sheets collection contains all of these. The following example activates the sheet named "Chart1" in the active workbook.

Sub ActivateChart()
    Sheets("Chart1").Activate
End Sub
  

Note   Charts embedded in a worksheet are members of the ChartObjects collection, whereas charts that exist on their own sheets belong to the Charts collection.

Referring to Sheets by Index Number

An index number is a sequential number assigned to a sheet, based on the position of its sheet tab (counting from the left) among sheets of the same type. The following procedure uses the Worksheets property to activate worksheet one in the active workbook.

Sub FirstOne()
    Worksheets(1).Activate
End Sub
  

If you want to work with all types of sheets (worksheets, charts, modules, and dialog sheets), use the Sheets property. The following procedure activates sheet four in the workbook.

Sub FourthOne()
    Sheets(4).Activate
End Sub
  

Note  The index order can change if you move, add, or delete sheets.

Opening a Workbook

When you open a workbook using the Open method, it becomes a member of the Workbooks collection. The following procedure opens a workbook named MyBook.xls located in the folder named MyFolder on drive C.

Sub OpenUp()
    Workbooks.Open("C:\MyFolder\MyBook.xls")
End Sub
  

Creating a New Workbook

A better way to create a new workbook is to assign it to an object variable. In the following example, the Workbook object returned by the Add method is assigned to an object variable, newBook. Next, several properties of newBook are set. You can easily control the new workbook using the object variable.

Sub AddNew()
Set NewBook = Workbooks.Add
    With NewBook
        .Title = "All Sales"
        .Subject = "Sales"
        .SaveAs Filename:="Allsales.xls"
    End With
End Sub
  

Tab Property

Microsoft Excel determines if the worksheet's first tab color index is set to none and notifies the user.

Sub CheckTab()

    ' Determine if color index of 1st tab is set to none.
    If Worksheets(1).Tab.ColorIndex = xlColorIndexNone Then
        MsgBox "The color index is set to none for the 1st " & _
            "worksheet tab."
    Else
        MsgBox "The color index for the tab of the 1st worksheet " & _
            "is not set none."
    End If

End Sub
  

ThisCell Property

A function called "UseThisCell" contains the ThisCell property to notify the user of the cell address.

Function UseThisCell()

    MsgBox "The cell address is: " & _
        Application.ThisCell.Address

End Function

DeleteDuplicateRows

This macro will delete duplicate rows in a range.  To use, select a single-column range of cells, comprising the range of rows from which duplicates are to be deleted, e.g., C2:C99.   To determine whether a row has duplicates, the values in the selected column are compared. Entire rows are not compared against one another.  Only the selected column is used for comparison.  When duplicate values are found in the active column, the first row remains, and all subsequent rows are deleted.
Public Sub DeleteDuplicateRows()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DeleteDuplicateRows
' This will delete duplicate records, based on the Active Column. That is,
' if the same value is found more than once in the Active Column, all but
' the first (lowest row number) will be deleted.
'
' To run the macro, select the entire column you wish to scan for
' duplicates, and run this procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim R As Long
Dim N As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Set Rng = Application.Intersect(ActiveSheet.UsedRange, _
                    ActiveSheet.Columns(ActiveCell.Column))

Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0")

N = 0
For R = Rng.Rows.Count To 2 Step -1
If R Mod 500 = 0 Then
    Application.StatusBar = "Processing Row: " & Format(R, "#,##0")
End If

V = Rng.Cells(R, 1).Value
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Note that COUNTIF works oddly with a Variant that is equal to vbNullString.
' Rather than pass in the variant, you need to pass in vbNullString explicitly.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If V = vbNullString Then
    If Application.WorksheetFunction.CountIf(Rng.Columns(1), vbNullString) > 1 Then
        Rng.Rows(R).EntireRow.Delete
        N = N + 1
    End If
Else
    If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
        Rng.Rows(R).EntireRow.Delete
        N = N + 1
    End If
End If
Next R

EndMacro:

Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Duplicate Rows Deleted: " & CStr(N)

End Sub

DeleteRowOnCell

The macro DeleteBlankRows will delete a row if the entire row is blank.  This macro will delete the entire row if a the cell in the specified column is blank.  Only this column is checked. Other columns are ignored.

Public Sub DeleteRowOnCell()

On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange

End Sub

To use this macro, select a columnar range of cells, and then run the macro.    If the cell in that column is blank, the entire row will be deleted.  To process the entire column, click the column header to select the entire column.

Delete Blank Rows

The DeleteBlankRows procedure shown below will delete all blank rows in the worksheet specified by the WorksheetName parameter. If this parameter is omitted, the active sheet is used. The procedure will delete rows that are entirely blank or contain cells that have only a single apostrophe (text formatting control character).  The procedure requires the IsRowClear function, shown after the DeleteBlankRows procedure. It will not delete rows that contain formulas, even if that formula returns an empty value. The function will not delete rows that are precedents of a formula in a cell if those precedent rows have lower row number than the row.  For example, if rows 1 to 5 are completely blank, and a formula in A10 references rows 1 to 5, rows 1 to 5 will not be deleted.  However, if a formula refers to a range in higher numbered rows than the cell containing the formula, and those rows are entirely blank, those rows referenced by the formula will be deleted. Therefore, the reference of the formula may be changed as rows above the formula are deleted.

Sub DeleteBlankRows(Optional WorksheetName As Variant)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DeleteBlankRows
' This function will delete all blank rows on the worksheet
' named by WorksheetName. This will delete rows that are
' completely blank (every cell = vbNullString) or that have
' cells that contain only an apostrophe (special Text control
' character).
' The code will look at each cell that contains a formula,
' then look at the precedents of that formula, and will not
' delete rows that are a precedent to a formula. This will
' prevent deleting precedents of a formula where those
' precedents are in lower numbered rows than the formula
' (e.g., formula in A10 references A1:A5). If a formula
' references cell that are below (higher row number) the
' last used row (e.g, formula in A10 reference A20:A30 and
' last used row is A15), the refences in the formula will
' be changed due to the deletion of rows above the formula.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim RefColl As Collection
Dim RowNum As Long
Dim Prec As Range
Dim Rng As Range
Dim DeleteRange As Range
Dim LastRow As Long
Dim FormulaCells As Range
Dim Test As Long
Dim WS As Worksheet
Dim PrecCell As Range

If IsMissing(WorksheetName) = True Then
    Set WS = ActiveSheet
Else
    On Error Resume Next
    Set WS = ActiveWorkbook.Worksheets(WorksheetName)
    If Err.Number <> 0 Then
        '''''''''''''''''''''''''''''''
        ' Invalid worksheet name.
        '''''''''''''''''''''''''''''''
        Exit Sub
    End If
End If
   

If Application.WorksheetFunction.CountA(WS.UsedRange.Cells) = 0 Then
    ''''''''''''''''''''''''''''''
    ' Worksheet is blank. Get Out.
    ''''''''''''''''''''''''''''''
    Exit Sub
End If

''''''''''''''''''''''''''''''''''''''
' Find the last used cell on the
' worksheet.
''''''''''''''''''''''''''''''''''''''
Set Rng = WS.Cells.Find(what:="*", after:=WS.Cells(WS.Rows.Count, WS.Columns.Count), lookat:=xlPart, _
    searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=False)

LastRow = Rng.Row

Set RefColl = New Collection

'''''''''''''''''''''''''''''''''''''
' We go from bottom to top to keep
' the references intact, preventing
' #REF errors.
'''''''''''''''''''''''''''''''''''''
For RowNum = LastRow To 1 Step -1
    Set FormulaCells = Nothing
    If Application.WorksheetFunction.CountA(WS.Rows(RowNum)) = 0 Then
        ''''''''''''''''''''''''''''''''''''
        ' There are no non-blank cells in
        ' row R. See if R is in the RefColl
        ' reference Collection. If not,
        ' add row R to the DeleteRange.
        ''''''''''''''''''''''''''''''''''''
        On Error Resume Next
        Test = RefColl(CStr(RowNum))
        If Err.Number <> 0 Then
            ''''''''''''''''''''''''''
            ' R is not in the RefColl
            ' collection. Add it to
            ' the DeleteRange variable.
            ''''''''''''''''''''''''''
            If DeleteRange Is Nothing Then
                Set DeleteRange = WS.Rows(RowNum)
            Else
                Set DeleteRange = Application.Union(DeleteRange, WS.Rows(RowNum))
            End If
        Else
            ''''''''''''''''''''''''''
            ' R is in the collection.
            ' Do nothing.
            ''''''''''''''''''''''''''
        End If
        On Error GoTo 0
        Err.Clear
    Else
        '''''''''''''''''''''''''''''''''''''
        ' CountA > 0. Find the cells
        ' containing formula, and for
        ' each cell with a formula, find
        ' its precedents. Add the row number
        ' of each precedent to the RefColl
        ' collection.
        '''''''''''''''''''''''''''''''''''''
        If IsRowClear(RowNum:=RowNum) = True Then
            '''''''''''''''''''''''''''''''''
            ' Row contains nothing but blank
            ' cells or cells with only an
            ' apostrophe. Cells that contain
            ' only an apostrophe are counted
            ' by CountA, so we use IsRowClear
            ' to test for only apostrophes.
            ' Test if this row is in the
            ' RefColl collection. If it is
            ' not in the collection, add it
            ' to the DeleteRange.
            '''''''''''''''''''''''''''''''''
            On Error Resume Next
            Test = RefColl(CStr(RowNum))
            If Err.Number = 0 Then
                ''''''''''''''''''''''''''''''''''''''
                ' Row exists in RefColl. That means
                ' a formula is referencing this row.
                ' Do not delete the row.
                ''''''''''''''''''''''''''''''''''''''
            Else
                If DeleteRange Is Nothing Then
                    Set DeleteRange = WS.Rows(RowNum)
                Else
                    Set DeleteRange = Application.Union(DeleteRange, WS.Rows(RowNum))
                End If
            End If
        Else
            On Error Resume Next
            Set FormulaCells = Nothing
            Set FormulaCells = WS.Rows(RowNum).SpecialCells(xlCellTypeFormulas)
            On Error GoTo 0
            If FormulaCells Is Nothing Then
                '''''''''''''''''''''''''
                ' No formulas found. Do
                ' nothing.
                '''''''''''''''''''''''''
            Else
                '''''''''''''''''''''''''''''''''''''''''''''''''''
                ' Formulas found. Loop through the formula
                ' cells, and for each cell, find its precedents
                ' and add the row number of each precedent cell
                ' to the RefColl collection.
                '''''''''''''''''''''''''''''''''''''''''''''''''''
                On Error Resume Next
                For Each Rng In FormulaCells.Cells
                    For Each Prec In Rng.Precedents.Cells
                        RefColl.Add Item:=Prec.Row, key:=CStr(Prec.Row)
                    Next Prec
                Next Rng
                On Error GoTo 0
            End If
        End If
       
    End If
   
    '''''''''''''''''''''''''
    ' Go to the next row,
    ' moving upwards.
    '''''''''''''''''''''''''
Next RowNum


''''''''''''''''''''''''''''''''''''''''''
' If we have rows to delete, delete them.
''''''''''''''''''''''''''''''''''''''''''

If Not DeleteRange Is Nothing Then
    DeleteRange.EntireRow.Delete shift:=xlShiftUp
End If

End Sub

Function IsRowClear(RowNum As Long) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''
' IsRowClear
' This procedure returns True if all the cells
' in the row specified by RowNum as empty or
' contains only a "'" character. It returns False
' if the row contains only data or formulas.
''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ColNdx As Long
Dim Rng As Range
ColNdx = 1
Set Rng = Cells(RowNum, ColNdx)
Do Until ColNdx = Columns.Count
    If (Rng.HasFormula = True) Or (Rng.Value <> vbNullString) Then
        IsRowClear = False
        Exit Function
    End If
    Set Rng = Cells(RowNum, ColNdx).End(xlToRight)
    ColNdx = Rng.Column
Loop

IsRowClear = True

End Function

Flipping Or Mirroring A Range

This macro will reverse the order of a range of data.  You may flip data in a single row or in a single column of data (i.e., an N by 1 array or an 1 by N array).   You may not select and entire row or an entire column.

Public Sub FlipSelection()

Dim Arr() As Variant
Dim Rng As Range
Dim C As Range
Dim Rw As Long
Dim Cl As Long

On Error GoTo EndMacro

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Set Rng = Selection
Rw = Selection.Rows.Count
Cl = Selection.Columns.Count
If Rw > 1 And Cl > 1 Then
   MsgBox "Selection May Include Only 1 Row or 1 Column", _
    vbExclamation, "Flip Selection"
Exit Sub
End If

If Rng.Cells.Count = ActiveCell.EntireRow.Cells.Count Then
    MsgBox "You May Not Select An Entire Row", vbExclamation, _
        "Flip Selection"
    Exit Sub
End If
If Rng.Cells.Count = ActiveCell.EntireColumn.Cells.Count Then
    MsgBox "You May Not Select An Entire Column", vbExclamation, _
        "Flip Selection"
    Exit Sub
End If

If Rw > 1 Then
    ReDim Arr(Rw)
Else
    ReDim Arr(Cl)
End If

Rw = 0
For Each C In Rng
    Arr(Rw) = C.Formula
    Rw = Rw + 1
Next C

Rw = Rw - 1
For Each C In Rng
    C.Formula = Arr(Rw)
    Rw = Rw - 1
Next C

EndMacro:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub

Getting A Built-In Or Custom Document Property

This macro will return the value of a custom or built-in document property.  If the property does not exist, and empty string is returned.

Public Function GetProperty(p As String)
Dim S As Variant

On Error Resume Next

S = ActiveWorkbook.CustomDocumentProperties(p)
If S <> "" Then
    GetProperty = S
    Exit Function
End If

On Error GoTo EndMacro
GetProperty = ActiveWorkbook.BuiltinDocumentProperties(p)
Exit Function

EndMacro:
GetProperty = ""

End Function

Headers And Footers

From the Page Setup dialog, you can set up some basic headers and footers, but you're somewhat limited.  With VBA, however, you can create your own custom headers and footers:

Activesheet.Pagesetup.Leftfooter = "Some Text"

In addition to Leftfooter, you can use CenterFooter, RightFooter, LeftHeader, CenterHeader,or RightHeader.

To include one of the built-in document properties in a footer (or header), use

Activesheet.Pagesetup.Leftfooter =     ActiveWorkbook.Builtinproperties("Manager")

Of course, change "Manager" to the name of the property you want to include.

Highlighting The Active Cell

If you want to make the active cell appear in a special color, use the following code in the Workbook_SheetSelectionChange event of the workbook.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object,
    ByVal Target As Excel.Range)
Static OldRange As Range
On Error Resume Next
Target.Interior.ColorIndex = 6 ' yellow - change as needed
OldRange.Interior.ColorIndex = xlColorIndexNone
Set OldRange = Target

End Sub

Playing WAV Files From VBA

It is very simple to have your macro code play a WAV file.  First, add a Windows95 API declaration at the top of your code module:

Declare Function sndPlaySound32 Lib "winmm.dll" Alias _
    "sndPlaySoundA" (ByVal lpszSoundName As String, _
    ByVal uFlags As Long) As Long

Then, call the function, passing it the name of the WAV file you want to play:

Call sndPlaySound32("c:\test\MySound.WAV", 0)

Printing Comments To Word

This macro will print all of the cell comments to Microsoft Word.  The Word application will remain
open and active.  You may then save or print the cell comment document.    Make sure that
you have enabled references to Word objects, from the Tools->References menu.

Public Sub PrintCellComments()

Dim Cmt As String
Dim C As Range
Dim I As Integer
Dim WordObj As Object
Dim ws As Worksheet
Dim PrintValue As Boolean
Dim res As Integer
On Error Resume Next
Err.Number = 0

res = MsgBox("Do want to print cell values with comments?", _
    vbYesNoCancel + vbQuestion, "Print Cell Comments")
Select Case res
    Case vbCancel
        Exit Sub
    Case vbYes
        PrintValue = True
    Case Else
        PrintValue = False
End Select

Set WordObj = GetObject(, "Word.Application")
If Err.Number = 429 Then
    Set WordObj = CreateObject("Word.Application")
    Err.Number = 0
End If

WordObj.Visible = True
WordObj.Documents.Add
With WordObj.Selection
.TypeText Text:="Cell Comments In Workbook: " + ActiveWorkbook.Name
.TypeParagraph
.TypeText Text:="Date: " + Format(Now(), "dd-mmm-yy hh:mm")
.TypeParagraph
.TypeParagraph
End With

For Each ws In Worksheets
    For I = 1 To ws.Comments.Count
        Set C = ws.Comments(I).Parent
        Cmt = ws.Comments(I).Text
        With WordObj.Selection
        .TypeText Text:="Comment In Cell: " + _
            C.Address(False, False, xlA1) + " on sheet: " + ws.Name
        If PrintValue = True Then
            .TypeText Text:=" Cell Value: " + Format(C.Value)
        End If
        .TypeParagraph
        .TypeText Text:=Cmt
        .TypeParagraph
        .TypeParagraph
        End With
    Next I
Next ws

Set WordObj = Nothing
MsgBox "Finished Printing Comments To Word", vbInformation, _
    "PrintCellComments"

End Sub

Printing Formulas To Word

This macro will print all of the cell values and formulas to Microsoft Word.  The Word application will
remain open and active.  You may then save or print the document.  Make sure that
you have enabled references to Word objects, from the Tools->References menu.

Public Sub PrintFormulasToWord()

Dim Cnt As String
Dim C As Range

Dim WordObj As word.Application
Dim HasArr As Boolean

On Error Resume Next
Err.Number = 0

Set WordObj = GetObject(, "Word.Application")
If Err.Number = 429 Then
    Set WordObj = CreateObject("Word.Application")
    Err.Number = 0
End If

WordObj.Visible = True
WordObj.Documents.Add

With WordObj.Selection
    .Font.Name = "Courier New"
    .TypeText "Formulas In Worksheet: " + ActiveSheet.Name   
    .TypeParagraph
    .TypeText "Cells: " + Selection.Cells(1,1).Address(False,False,xlA1) _             & " to " & Selection.Cells(Selection.Rows.Count,  _
            Selection.Columns.Count).Address(False, False, xlA1)
    .TypeParagraph
    .TypeParagraph
End With

For Each C In Selection
    HasArr = C.HasArray
    Cnt = C.Formula
    If HasArr Then
        Cnt = "{" + Cnt + "}"
    End If
    If Cnt <> "" Then
        With WordObj.Selection
            .Font.Bold = True
            .TypeText C.Address(False, False, xlA1) & ": "
            .Font.Bold = False
            .TypeText Cnt
            .TypeParagraph
            .TypeParagraph
        End With
    End If
Next C
MsgBox "Done printing formulas to Word. ", , "Print Formulas To Word"

End Sub

Saving And Returning To A Location

These three macros are used to save a location and then return to that location later.   It is
useful when you need to change the Selection range during the execution of a macro, and then
return to the original Selection range when your macro is complete.

Public Sub SaveLocation(ReturnToLoc As Boolean)

Static WB As Workbook
Static WS As Worksheet
Static R As Range

If ReturnToLoc = False Then
    Set WB = ActiveWorkbook
    Set WS = ActiveSheet
    Set R = Selection
Else
    WB.Activate
    WS.Activate
    R.Select
End If

End Sub

To save the current location, call SetSaveLoc.

Public Sub SetSaveLoc()
    SaveLocation (False)
End Sub

To return to the saved location, call GetSaveLoc.

Public Sub GetSaveLoc()
    SaveLocation (True)
End Sub

Saving All Workbooks

This macro will save all of the workbooks open in Excel.

Public Sub SaveAll()

Dim WB As Workbook
For Each WB In Workbooks
    WB.Save
Next WB
Application.StatusBar = "All Workbooks Saved."

End Sub

Selecting The Current Array

If the ActiveCell is part of an array, this macro will select the entire array.

Public Sub SelectArray()

Dim Msg As String

On Error GoTo EndOfMacro
Msg = "Cell is not part of an array."

ActiveCell.CurrentArray.Select
Msg = "Array Selected."


EndOfMacro:
Application.StatusBar = Msg

End Sub

Selecting The Current Named Range

If the ActiveCell is part of a named range, this macro will select the entire named range.
This macro requires the CellInNamedRange function, shown first.

CellInNamedRange

Public Function CellInNamedRange(Rng As Range) As String

Dim N As Name
Dim C As Range
Dim TestRng As Range
On Error Resume Next

For Each N In ActiveWorkbook.Names
    Set C = Nothing
    Set TestRng = N.RefersToRange
    Set C = Application.Intersect(TestRng, Rng)
    If Not C Is Nothing Then
        CellInNamedRange = N.Name
        Exit Function
    End If
Next N
CellInNamedRange = ""

End Function

SelectRange

Public Sub SelectRange()

Dim RngName As String
Dim R As Range
Set R = ActiveCell
Dim Msg As String

Msg = "Active Cell Is Not In A Named Range."
RngName = CellInNamedRange(R)
If RngName <> "" Then
    Range(RngName).Select
    Msg = "Range: " + RngName + " Selected."
End If

Application.StatusBar = Msg

End Sub

CellIn Named Range

Public Function CellInNamedRange(Rng As Range) As String

Dim N As Name
Dim C As Range
Dim TestRng As Range
On Error Resume Next

For Each N In ActiveWorkbook.Names
    Set C = Nothing
    Set TestRng = N.RefersToRange
    Set C = Application.Intersect(TestRng, Rng)
    If Not C Is Nothing Then
        CellInNamedRange = N.Name
        Exit Function
    End If
Next N
CellInNamedRange = ""

End Function

SelectRange

Public Sub SelectRange()

Dim RngName As String
Dim R As Range
Set R = ActiveCell
Dim Msg As String

Msg = "Active Cell Is Not In A Named Range."
RngName = CellInNamedRange(R)
If RngName <> "" Then
    Range(RngName).Select
    Msg = "Range: " + RngName + " Selected."
End If

Application.StatusBar = Msg

End Sub

Sheet Names

It is very simple to retrieve sheet names in VBA.  They are stored in two collection objects in the ActiveWorkbook object: the Sheets collection and the Worksheets collection.  The Sheets collection contains both worksheets and chart sheets.   The Worksheets collection contains only worksheets.

To retrieve the name of the first sheet in the workbook, use

Public Function FirstSheetName()
    FirstSheetName = Sheets(1).Name
End Function

To retrieve the name of the last sheet in the workbook, use

Public Function LastSheetName()
    LastSheetName = Sheets(Sheets.Count).Name
End Function

You can return an array of all the sheet names with the following

Public Function AllSheetNames()
    Dim Arr() As String
    Dim I as Integer
    Redim Arr(Sheets.Count-1)
    For I = 0 To Sheets.Count - 1
        Arr(i) = Sheets(I+1).Name
    Next I
    AllSheetNames = Arr      ' return a row array OR
    AllSheetNames = Application.Worksheetfunction.Transpose(Arr)
                             ' return a column array
End Function

Closing All Inactive Workbooks

This macro will close all of the workbooks, except the active workbook, which will remain open active.

Public Sub CloseAllInactive()

Dim Wb As Workbook
Dim AWb As String
AWb = ActiveWorkbook.Name

SaveAll
For Each Wb In Workbooks
    If Wb.Name <> AWb Then
        Wb.Close savechanges:=True
    End If
Next Wb
Application.StatusBar = "All Workbooks Closed."

End Sub

Closing All Workbooks

This macro will close all of the workbooks open in Excel. 

Public Sub CloseAll()

Dim Wb As Workbook
SaveAll
For Each Wb In Workbooks
    If Wb.Name <> ThisWorkbook.Name Then
        Wb.Close savechanges:=True
    End If
Next Wb
ThisWorkbook.Close savechanges:=True

End Sub

Macro Compare two lists and delete duplicate items

The following sample macro compares one (master) list against another list, and deletes duplicate items in the second list that are also in the master list. The first list is on Sheet1 in the range A1:A10. The second list is on Sheet2 in the range A1:A100. To use the macro, select either sheet, and then run the macro.

Sub DelDups_TwoLists()
Dim iListCount As Integer
Dim iCtr As Integer

' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False

' Get count of records to search through (list that will be deleted).
iListCount = Sheets("sheet2").Range("A1:A100").Rows.Count

' Loop through the "master" list.
For Each x In Sheets("Sheet1").Range("A1:A10")
   ' Loop through all records in the second list.
   For iCtr = 1 To iListCount
      ' Do comparison of next record.
      ' To specify a different column, change 1 to the column number.
      If x.Value = Sheets("Sheet2").Cells(iCtr, 1).Value Then
         ' If match is true then delete row.
         Sheets("Sheet2").Cells(iCtr, 1).Delete xlShiftUp
         ' Increment counter to account for deleted row.
         iCtr = iCtr + 1
      End If
   Next iCtr
Next
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

Delete duplicate items in a single list

The following sample macro searches a single list in the range A1:A100 and deletes all duplicate items in the list. This macro requires that you do not have empty cells in the list range. If your list does contain empty cells, sort the data in ascending order so that the empty cells are all at the end of your list.

Sub DelDups_OneList()
Dim iListCount As Integer
Dim iCtr As Integer

' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False

' Get count of records to search through.
iListCount = Sheets("Sheet1").Range("A1:A100").Rows.Count
Sheets("Sheet1").Range("A1").Select
' Loop until end of records.
Do Until ActiveCell = ""
   ' Loop through records.
   For iCtr = 1 To iListCount
      ' Don't compare against yourself.
      ' To specify a different column, change 1 to the column number.
      If ActiveCell.Row <> Sheets("Sheet1").Cells(iCtr, 1).Row Then
         ' Do comparison of next record.
         If ActiveCell.Value = Sheets("Sheet1").Cells(iCtr, 1).Value Then
            ' If match is true then delete row.
            Sheets("Sheet1").Cells(iCtr, 1).Delete xlShiftUp
               ' Increment counter to account for deleted row.
               iCtr = iCtr + 1
         End If
      End If
   Next iCtr
   ' Go to next record.
   ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

Macro to Change All Text in a Cell Range to Initial Capital Letters

Sub Proper_Case()
   ' Loop to cycle through each cell in the specified range.
   For Each x In Range("C1:C5")
      ' There is not a Proper function in Visual Basic for Applications.
      ' So, you must use the worksheet function in the following form:
      x.Value = Application.Proper(x.Value)
   Next
End Sub

Macro to Change All Text in a Range to Lowercase Letters

Sub Lowercase()
   ' Loop to cycle through each cell in the specified range.
   For Each x In Range("B1:B5")
      x.Value = LCase(x.Value)
   Next
End Sub

Macro to Change All Text in a Range to Uppercase Letters

Sub Uppercase()
   ' Loop to cycle through each cell in the specified range.
   For Each x In Range("A1:A5")
      ' Change the text in the range to uppercase letters.
      x.Value = UCase(x.value)
   Next
End Sub

Counting Rows & Columns & Sheets

When you have selected a range, it is sometimes useful to know how many rows or columns you have selected as this information can be used in your macros (for eg when you have reached the end, you will know it is time to stop the macros. This macro will do the trick.

Sub Count()
myCount = Selection.Rows.Count    'Change Rows to Columns to count columns
MsgBox myCount
End Sub

The next macro counts the number of sheets instead. Refer to Protecting all sheets macro which uses this method.

Sub Count2()
myCount = Application.Sheets.Count
MsgBox myCount
End Sub

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