Lesson 3: Project 1
This lesson will focus on a real project and we will see how to use macros to solve the problem.
Introduction
In this lesson we will look at a real problem that had to be solved. It is not terribly difficult, but it will illustrate many of the techniques that you will use in your macros. The main point is to get you thinking through the process of converting a problem into a solution. All of the macros and spreadsheets are in Lesson 3.xls.
The Files: PDF Version of Lesson 3
The Problem
Open up Lesson 3.xls - the problem definition given to me was "I need this spreadsheet format {Old Format} to be made to look like this one {New Format}". So, we basically have to convert one spreadsheet layout to a different one.
This would seem to be a pretty trivial exercise and you may wonder why we would not do this by hand. Well, it was being done by hand, but the individual having to do it was getting tired of having to do this 2-3 times a week - it also started off being for just one manager group but would soon have to be done for a number of managers. Thus, what started out as one spreadsheet having to be manipulated once or twice a week was fast approaching a full time job.
Also, because it is kind of a tedious task, it is easy to make mistakes. This is an ideal task for a macro. Now you may also be wondering why we do this at all, I don't know, they just make us do this where I work! I'm sure someone, somewhere knows, but it is not me.
The Requirements
The requirements are pretty easy with this one. Start out with the Old Format and end up with the New Format. We have almost all of the data in our old format, and so it is a case of deleting columns and rows we don't want, inserting new columns and rows, and a bit of renaming. First off, let's list what we think we need to do. To make this easier, I usually print off each sheet and compare them to determine the differences.
Comparing the two sheets, here is what I think needs to happen. I will number these so that I can later relate the requirement to the code, and also make sure that I don't forget one or more of the requirements.
- Transform the existing {Old Format} sheet to the new one - at the end of the process there will be only one sheet.
- Delete Columns B, C, E, F, I, and U - remember about deleting columns right to left, that way, the column letters of earlier columns will not change after the first column is deleted.
- Insert a new column at the left, fill it with "00545" and create a title of "CC"
- Remove rows that contain the following values in column "A" - "ADMIN", "FTE", "Total", "XXAAA", "xxc02", "ELINK".
- Change the width of the numeric columns to 6.71 (from new format sheet)
- Set titles of columns "A", "C", and "D" to "CC", "SR", and "Appl" respectively.
- Remove all formatting of text - Blue and Red characters and the little boxes.
- Change the current month names to numeric YearMonth. i.e. Dec will be 200312.
- Populate Manager column with "Person 1".
- Set title row height to 27 and fill with light shading.
- Make the title row line 5.
- Populate row 3, over the numeric date columns with the following values - 149.7, 149.1, 168.8 and 1 for the rest of them.
- Create a total line of the numeric columns, 3 rows below the last data row.
- Create a value that is the total row divided by the corresponding value in row 3 - place 4 rows below last data row.
Wow, 14 things to do; now you can see why a macro might be useful. I've kind of listed the requirements in the order in which I will do them, but generally you can vary this - the only critical ones may be where they are dependent on a previous activity being completed such as 13 before 14. Okay, let's get to it.
The reformat macro is in module1, but I will go through the important lines of code and how I came up with them
Dim rng As Range Dim xrng As Range Dim lLastRow As Integer Dim lLastCol As Integer Dim rDelCnt As Integer Dim cDelCnt As Integer Dim i As Integer Dim colLetter As String Application.StatusBar = "Processing Data FIle"
Our usual list of variables. Notice I display a message in the status bar.
Set rng = Range("A1").SpecialCells(xlCellTypeLastCell)
lLastRow = rng.Row
lLastCol = rng.Column
Get last Row and Column values.
Columns("U").Delete
Columns("I").Delete
Columns("E:F").Delete
Columns("B:C").Delete
cDelCnt = 6
Here we delete the unwanted columns. This is easy when done in reverse. The code for this was obtained from the macro keystroke recorder. After this, I update a variable cDelCnt with the value 6, the number of columns deleted. I do this because when you delete rows or columns after you initially get the LastRow and LastCol values, these values are not updated. Even if you repeat the Set.rng statement, Excel still thinks that it has the original number of rows and columns. So, I update the values manually. Now, if you close the spreadsheet, reopen and then execute the Set.rng statement it will have the correct values. That gets requirement [2].
Update the col value
lLastCol = lLastCol - cDelCnt rDelCnt = 0
Now this next bit of code is not pretty, but it is simple and works. You could do it with a CASE style statement, but my old Shaolin Programming Master always used to say "Simple is best, confused one", at least that is what I think he was saying!
I use a For loop to work through the rows, notice I'm going bottom to top (line 5), this time I use the Cells(Rows.Count, "A").End(xlUp).Row statement, which is another way to loop from the last row up. Don't you just love that there are many ways to do the same thing? It can sometimes be helpful.
For i = Cells(Rows.Count, "A").End(xlUp).Row To 5 Step -1 If (Cells(i, "A").Value Like "*ADMIN*") Then Cells(i, "A").EntireRow.Delete rDelCnt = rDelCnt + 1 ElseIf IsEmpty(Cells(i, "A").Value) Then Cells(i, "A").EntireRow.Delete rDelCnt = rDelCnt + 1 ElseIf (Cells(i, "A").Value Like "*XXAAA*") Then Cells(i, "A").EntireRow.Delete rDelCnt = rDelCnt + 1 ElseIf (Cells(i, "A").Value Like "*ELINK*") Then Cells(i, "A").EntireRow.Delete rDelCnt = rDelCnt + 1 ElseIf (Cells(i, "A").Value Like "*xxC02*") Then Cells(i, "A").EntireRow.Delete rDelCnt = rDelCnt + 1 ElseIf (Cells(i, "A").Value Like "*FTE*") Then Cells(i, "A").EntireRow.Delete rDelCnt = rDelCnt + 1 ElseIf (Cells(i, "A").Value Like "*Total*") Then Cells(i, "A").EntireRow.Delete rDelCnt = rDelCnt + 1 End If Next i' resize data lLastRow = lLastRow - rDelCnt
In each case I'm using the If test to check for the value in column "A"
(Cells(i, "A").Value Like "*XXAAA*")
Here I use the Cells statement with the row value given by the loop variable i, and the column is specified by "A". I use the Like phrase to ensure that I can find this value even if it is buried in other text. The Excel If statement is very literal, if there is a leading or trailing space in the value an exact match with the "=" symbol will not find the value. The tests can be performed in almost any order and I use the ElseIf to continue the statement. The only other one worth mentioning is the IsEmpty(…) phrase. This is an Excel function that checks for an empty cell. We can also use the reverse phrase Not IsEmpty. Which checks to see that the cell is not empty; I bet you are relieved by that!
At the end of the loop I update the row count with
lLastRow = lLastRow - rDelCnt
Where rDelCnt is incremented after each row is deleted. This takes care of requirement [4].
Columns("D:O").ColumnWidth = 6.71
Change the width of the numeric columns to 6.71 - I got this value from the new format sheet using Format->Column->Width. Requirement [5].
Range("A5").Select
Selection.EntireColumn.Insert
lLastCol = lLastCol + 1
Insert a new column. Because I selected cell "A5" first, the new column will be inserted to the left of this. Part of [3].
Range("A4").Select
ActiveCell.FormulaR1C1 = "CC"
Range("C4").Select
ActiveCell.FormulaR1C1 = "Appl"
Range("D4").Select
ActiveCell.FormulaR1C1 = "Mgr"
Change the headings of the first 3 columns to the required values. [6].
Range("B1:C3").Select
Selection.ClearContents
Selection.ClearFormats
Here I'm just clearing out the contents of the cells B1 to C3. First I set the range and Select it, then with the selection I apply ClearContents, which blanks out the cells, and ClearFormats, which wil get rid of anything else. This again illustrates the importance of the range object.
Set xrng = Range(Cells(4, 1), Cells(lLastRow, lLastCol)) xrng.Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone With Selection.Font .Name = "Arial" .Size = 10 .Bold = False .ColorIndex = 0 End With
In this block I clear out the little boxes and the colored text so that we can get the really boring one at the end. I first set the range with
Set xrng = Range(Cells(4, 1), Cells(lLastRow, lLastCol))
Notice that I'm using the Cells option within the Range statement. Cells(4,1) specifies the top left hand cell of the area, and Cells(lLqastRow, lLastCol) specifies the bottom right cell. Having set the range we then select it with xrng.Select, now we can apply the unformatting statements. You can bet I used the recorder to get these babies. I finish off with a change to the font type and size. This takes care of [7]. Boy, we are cooking now.
For i = 5 To lLastCol If Cells(4, i).Value = "DEC" Then Cells(4, i).Value = "200312" ElseIf Cells(4, i).Value = "JAN" Then Cells(4, i).Value = "20041" ElseIf Cells(4, i).Value = "FEB" Then Cells(4, i).Value = "20042" ElseIf Cells(4, i).Value = "MAR" Then Cells(4, i).Value = "20043" ElseIf Cells(4, i).Value = "APR" Then Cells(4, i).Value = "20044" ElseIf Cells(4, i).Value = "MAY" Then Cells(4, i).Value = "20045" ElseIf Cells(4, i).Value = "JUN" Then Cells(4, i).Value = "20046" ElseIf Cells(4, i).Value = "JUL" Then Cells(4, i).Value = "20047" ElseIf Cells(4, i).Value = "AUG" Then Cells(4, i).Value = "20048" ElseIf Cells(4, i).Value = "SEP" Then Cells(4, i).Value = "20049" ElseIf Cells(4, i).Value = "OCT" Then Cells(4, i).Value = "200410" ElseIf Cells(4, i).Value = "NOV" Then Cells(4, i).Value = "200411" ElseIf (Cells(4, i).Value = "DEC" And i > 10) Then Cells(4, i).Value = "200412" End If Next i
Another scary one, but again, simple. Here we want the values such as "DEC, "JAN" and so on, converted to the yearMonthnumber. So, "DEC" will be 200312, and "JAN" will be 200401. Notice that I have to qualify the possible second "DEC" value with a test that the column value is greater than 10, so it will not be confused with the DEC in 2003. I'm using a variable column value with a fixed row value this time. [8].
For i = 5 To lLastRow Cells(i, "A").Value = "'00545" Cells(i, "D").Value = "Person 1" Next i
Okay, here we are populating the new column with "00545" and putting the value "Person 1" in place of manager. Pretty simple, but it's a good job that we updated the lLastRow value. This completes requirement [3] and also [9].
Range("A3").Select
Selection.EntireRow.Insert
Cells(5, "A").RowHeight = 27
lLastRow = lLastRow + 1
Range("A5:P5").Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Again a pretty straightforward process to insert a row to make the title row number to be 5; set the height of the title row to 27 and fill in the range "QA5:P5" with a light shading. This gets requirements [10, 11].
Cells(3, 5).Value = 149.7 Cells(3, 6).Value = 149.1 Cells(3, 7).Value = 168.8 For i = 8 To 16 Cells(3, i).Value = 1 Next i
Populate the first 3 numeric columns with these values and 1 for the rest. These represent the number of billable hours for each of the months, the values for the other months have not yet been determined, hence the value of 1. This is an accounting thing! [12].
For i = 5 To lLastCol
colLetter = Left(Cells(1, i).Address(False, False), _
1 - CInt(Cells(1, i).Column > 26))
Cells(lLastRow + 3, i).Formula = "=SUM(" & colLetter & 6 & ":" & colLetter & lLastRow & ")"
Cells(lLastRow + 4, i).Formula = "=SUM(" & colLetter & (lLastRow + 3) & "/" & colLetter & 3 & ")"
Next i
Now this last bit of code will take a bit of explaining: The requirement was to provide a total line for each of the numeric columns, 3 rows past the last data line. The usual expression for this is the SUM function where you would normally specify
=SUM(firstRowCol:lastRowCol)
Now we know the first and last rows, they are 6 and lLastRow respectively. However, even though we know the column numbers; we don't know the equivalent letters, at least not for a loop. We could hard code the statement for each column, but that would be boring. So, first we find out the corresponding column letter as we loop through each column 5 to the last one.
Loop is given by
For i = 5 To lLastCol
Now we get the column letter using
colLetter = Left(Cells(1, i).Address(False, False), _ 1 - CInt(Cells(1, i).Column > 26))
This is a function that uses the .Address property of the Cells object and converts it to a letter, taking account that there are 26 initial letters. I know that it seems confusing, but it does work, so don't get hung up on this at the moment, you can always figure it out later. I now have the row range, and I can get the column letter. If we look back at the expression we have to create we can break it down into two types of values - the bits that are fixed, and the variable bits. I will list the fixed bits in green and the variable bits in red.
"=SUM(" & colLetter & "6" & ":" & colLetter & lLastRow & ")"
It looks very complex, but if you break it down you can see each element. This will generate the string '=SUM(E6:E61)" for the fist numeric column. Having generated this string we have to use the statement
Cells(lLastRow + 3, i).Formula =
to make the formula work. The expression lLastRow + 3, will place the formula in the 3rd row past the last data row, i gets the correct column, and the .Formula will apply the expression as a formula and not just the string "=SUM(E6:E61)". This and the other expression (very similar) takes care of requirements [13, 14].
Sheets.Add before:=Sheets(1)
Sheets(1).Name = "Person 1"
Sheets(2).Select
Cells.Select
Selection.Copy
Sheets(1).Select
ActiveSheet.Paste
Range("A1").Select
Application.DisplayAlerts = False
Sheets(2).Delete
This last little block of code just creates a new worksheet, names it "Person 1", and then copies the newly formatted spreadsheet data into it. Note, when referring to worksheets, you can reference them by name, such as Sheets("New Format"), or by number as in Sheets(2), where the 2 represents the 2nd sheet from the left. I could have left the original worksheet unaffected by this process, but it was simpler to just overwrite the old format with the new.
1
2
