Handy Tips for Working with Excel 2003

Applies to:
Microsoft Office Excel 2003

Summary: Find tips for developing with Microsoft Excel, compiled from the various Microsoft Excel newsgroups. By using these procedures and modifying them for your own use, you can make your own applications more robust and provide more options for your users. (10 printed pages)

Contents

Introduction
Printing Every Other Worksheet
Using ADO for Retrieving Sheet Names from a Workbook
Moving the Search Results to a Separate Page
Deleting a Portion of a Cell
Removing Blank Rows and Embedded Field Names from a Worksheet
Creating a Master List of Data
Inserting a Row Based on a Value
Converting Text to E-Mail Addresses
Manipulating Font Colors Based on Cell Values
Append a Character to a Cell Value
Conclusion
Additional Resources

Introduction

This article presents tips for working with Microsoft Office Excel 2003 that are compiled from various newsgroups. For those unfamiliar, newsgroups are a forum where users and developers can submit questions related to many technical subjects, such as Office applications. Questions are answered by users and other professionals. In this context, newsgroups are rich with information tailored to using and developing in your Office application of choice. The answers that make up these tips are the product of years of experience from super users and developers designated as Microsoft Most Valuable Professionals (MVPs). More information on newsgroups can be found at the newsgroup help site.

The code samples in this article are meant to be a starting point to customize for your own applications. These samples were tested in Excel 2003 but may also work in earlier versions of Excel. The samples should be tested in your own version of Excel before using them in your application.

Printing Every Other Worksheet

The code in this section is used to print every other worksheet in a workbook. It does this by looping through all of the worksheets and populating an array with the even-numbered sheets.

Sub PrintEvenSheets()

    Dim mySheetNames() As String
    Dim iCtr As Long
    Dim wCtr As Long
    
    iCtr = 0
    For wCtr = 1 To Sheets.Count
        If wCtr Mod 2 = 0 Then
            iCtr = iCtr + 1
            ReDim Preserve mySheetNames(1 To iCtr)
            mySheetNames(iCtr) = Sheets(wCtr).Name
        End If
    Next wCtr
    
    If iCtr = 0 Then
        'Only one sheet. Display message or do nothing.
    Else
        Sheets(mySheetNames).PrintOut preview:=True
    End If
    
End Sub

This example looked at printing even-numbered worksheets. You could loop through all sheets and build an array based on the even-numbered worksheets for printing. You can do this by removing the first If...Then End If statement in this sample.

Using ADO for Retrieving Sheet Names from a Workbook

This code sample uses Microsoft ActiveX Data Objects (ADO) to retrieve the names of worksheets from a workbook. Using ADO allows you to work with files outside of Excel. ADO uses a common programming model to access data in a number of forms. For more information on ADO, see the ADO Programmer's Guide.

Sub GetSheetNames()

    Dim objConn As Object
    Dim objCat As Object
    Dim tbl As Object
    Dim iRow As Long
    Dim sWorkbook As String
    Dim sConnString As String
    Dim sTableName As String
    Dim cLength As Integer
    Dim iTestPos As Integer
    Dim iStartpos As Integer

    'Change the path to suit your own needs.
    sWorkbook = "c:\myDir\Book1.xls"
    sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & sWorkbook & ";" & _
        "Extended Properties=Excel 8.0;"

    Set objConn = CreateObject("ADODB.Connection")
    objConn.Open sConnString
    Set objCat = CreateObject("ADOX.Catalog")
    Set objCat.ActiveConnection = objConn

    iRow = 1
    For Each tbl In objCat.Tables
        sTableName = tbl.Name
        cLength = Len(sTableName)
        iTestPos = 0
        iStartpos = 1
        'Worksheet names with embedded spaces are enclosed 
        'by single quotes.
        If Left(sTableName, 1) = "'" And Right(sTableName, 1) = "'" Then
            iTestPos = 1
            iStartpos = 2
        End If
        'Worksheet names always end in the "$" character.
        If Mid$(sTableName, cLength - iTestPos, 1) = "$" Then
            Cells(iRow, 1) = Mid$(sTableName, iStartpos, cLength - _
                (iStartpos + iTestPos))
            MsgBox Cells(iRow, 1)
            iRow = iRow + 1
        End If
    Next tbl
    objConn.Close
    Set objCat = Nothing
    Set objConn = Nothing

End Sub

Moving the Search Results to a Separate Page

This code sample searches the columns of a worksheet for the occurrence of a word ("Hello"). Once matching data is found, it is copied to another worksheet ("Search Results").

Sub FindMe()
    Dim intS As Integer
    Dim rngC As Range
    Dim strToFind As String, FirstAddress As String
    Dim wSht As Worksheet

    Application.ScreenUpdating = False

    intS = 1
    'This step assumes that you have a worksheet named
    'Search Results.
    Set wSht = Worksheets("Search Results")
    strToFind = "Hello"

    'Change this range to suit your own needs.
    With ActiveSheet.Range("A1:C2000")
        Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
        If Not rngC Is Nothing Then
            FirstAddress = rngC.Address
                Do
                    rngC.EntireRow.Copy wSht.Cells(intS, 1)
                    intS = intS + 1
                    Set rngC = .FindNext(rngC)
                Loop While Not rngC Is Nothing And rngC.Address <>
FirstAddress
        End If
    End With
    
End Sub

Deleting a Portion of a Cell

This procedure searches a range for a string value and deletes a portion of the contents of the cell. In this case, it deletes the characters "Y" or "N" from the string when it is separated from the body of the text by one or more spaces.

Sub RemoveString()
    Dim sStr as String, cell as Range
    'Change the worksheet and column values to suit your needs.
    For Each cell In Range("Sheet1!F:F")
        If cell.Value = "" Then Exit Sub
        sStr = Trim(Cell.Value)
        If Right(sStr, 3) = "  Y" Or Right(sStr, 3) = "  N" Then
            cell.Value = Left(sStr, Len(sStr) - 1)
        End If
    Next
End Sub

To remove the trailing spaces left by removing the Y or N, change:
cell.Value = Left(sStr, Len(sStr) - 1)

to
cell.Value = Trim(Left(sStr, Len(sStr) - 1))

Removing Blank Rows and Embedded Field Names from a Worksheet

This sample searches the contents of a column of data. If a cell is blank or if it contains a specific cell value ("Hello" in this example), the code deletes the row and then moves to check the next row.

Sub CleanUp()
    On Error Resume Next

    With ActiveSheet
        'Change the column value to suit your needs.
        LastRw = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng1 = .Range(Cells(1, "A"), Cells(LastRw, "A"))
        Set Rng2 = .Range(Cells(2, "A"), Cells(LastRw, "A"))
    End With

    With Rng1
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .AutoFilter Field:=1, Criteria1:="Hello"
        Rng2.SpecialCells(xlCellTypeVisible).EntireRow.Delete
       .AutoFilter
    End With

End Sub

Creating a Master List of Data

This code creates a master list by piecing together information from a worksheet. The sample creates a "Master" worksheet, searches a column until a blank cell is encountered, copies the scanned data to the Master worksheet, and then continues the search to the next blank cell.

Sub CopyData()
    Dim i As Long, rng As Range, sh As Worksheet
    'Change these worksheet names as needed.
    Worksheets.Add(After:=Worksheets( _
       Worksheets.Count)).Name = "Master"
    Set sh = Worksheets("Input-Sales")
    i = 1
    Do While Not IsEmpty(sh.Cells(i, 1))
        Set rng = Union(sh.Cells(i, 1), _
           sh.Cells(i + 2, 1).Resize(3, 1))
        rng.EntireRow.Copy Destination:= _
           Worksheets("Master").Cells(Rows.Count, 1).End(xlUp)
        i = i + 16
    Loop
End Sub

Inserting a Row Based on a Value

This sample searches a column for a value, and when found, inserts a blank row. This procedure searches column B for the value "1", and when found, inserts a blank row.

Sub InsertRow()
    Dim Rng As Range
    Dim findstring As String
    'Change the search string to suit your needs.
    findstring = "1"
    'Change the range to suit your needs.
    Set Rng = Range("B:B").Find(What:=findstring, LookAt:=xlWhole)
    While Not (Rng Is Nothing)
        Rng.EntireRow.Insert
        Set Rng = Range("B" & Rng.Row + 1 & ":B" & Rows.Count) _
            .Find(What:=findstring, LookAt:=xlWhole)
    Wend
End Sub

Converting Text to E-Mail Addresses

The following code cycles through a list of range data and converts each entry to an e-mail address.

Sub convertToEmail()
    Dim convertRng As Range
    'Change the range to suit your need.
    Set convertRng = Range("B13:B16")
    Dim rng As Range

    For Each rng In convertRng
        If rng.Value <> "" Then
            ActiveSheet.Hyperlinks.Add rng, "mailto:" & rng.Value
        End If
    Next rng

End Sub

Manipulating Font Colors Based on Cell Values

The following sample sets the font color of a cell to a certain color based on the value displayed in the cell. Specifically, the cell is set to black if the cell contains a formula such as "=today()" and is set to blue if the cell contains data such as "30 Oct 2004".

Sub ColorCells()
    On Error Resume Next
    With Sheet1.UsedRange
        .SpecialCells(xlCellTypeFormulas).Font.Color = vbBlack
        .SpecialCells(xlCellTypeConstants).Font.Color = vbBlue
    End With
    On Error GoTo 0
End Sub

The previous sample changes the font colors for the entire used range of a worksheet. The following code segments use the HasFormula property of the Range object to determine if a single cell contains a formula or not:

Sub ColorCells2()
    With Sheet1.Range("A3")
        If .HasFormula Then
            .Font.Color = vbBlack
        Else
            .Font.Color = vbBlue
        End If
    End With
End Sub

Or

Sub ColorCells3()
    With Cells(3, 3)
        .Interior.Color = IIf(.HasFormula, vbBlue, vbBlack)
    End With
End Sub

Append a Character to a Cell Value

The following procedure searches through the selected columns and appends a character, in this example an apostrophe, to the start of each entry. The code works as shown in the example if you have a range selected and you do not have Option Explicit declared. If only one cell is selected, then the code only operates on the active cell.

Sub AddApostrophe()
    Dim cell as Range
    for each cell in Selection
        if not cell.hasformula then
            if not isempty(cell) then
                cell.Value  = "'" & cell.Value
            End if
        end if
    Next
End sub

This variation on the above code puts a character (apostrophe) only in a numeric cell. The code only operates on numeric cells in the selection.

Sub AddApostrophe()
    Dim cell as Range
    for each cell in Selection
        if not cell.hasformula then
            if not isempty(cell) then
                if isnumeric(cell) then
                    'Change the character as needed.
                    cell.Value  = "'" & cell.Value
                end if
            End if
        end if
    Next
End sub

Conclusion

This article presents a number of tips and Microsoft Visual Basic for Applications (VBA) code for use in Excel. By using these procedures and modifying them for your own use, you can make your own applications more robust and provide more options to your users.

Additional Resources

The following is a list of additional resources that can assist you in developing for Excel:

• How to Use ADO with Excel Data from Visual Basic or VBA
• VBA Samples for Working with Excel 2003 Worksheets
• Excel Technical Articles on the MSDN Office Developer Center
• Excel Newsgroups

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/odc_xl2003_ta/html/odc_super.asp

<!--closes the topic content div--><!--FOOTER_END--><!-- End Content -->