Handy Tips for Working with Excel 2003
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)
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
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.
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.
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
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
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))
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
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
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
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
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
Sub ColorCells3() With Cells(3, 3) .Interior.Color = IIf(.HasFormula, vbBlue, vbBlack) End With End Sub
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
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.
The following is a list of additional resources that can assist you in developing for Excel: