Been awhile since I used Visual Basic for Applications. I mean it's like VBScript on steroids. So many things I'm used to now in Visual Studio 2008 that I take for granted. Simple things, like collapsing my subs and functions. Or not getting a compile error just because I click off somewhere to copy a variable name. Anyway, I had a friend of mine, ask me how to consolidate sheets in excel. At first I said, oh that's easy, however the more I looked into it, consolidating numbers works fine, but when it comes to text, not so much.
The idea was this....
Sheet1 is the "Master" sheet, which will hold all the information from the other Sheets.
Sheet2 looks sort of of like this...
| Name | Address | City | State | Zip |
| Bob Joe | 1234 Kingly | Tampa | FL | 33647 |
| Jane Doe | 352 Thisway | Clearwater | FL | 33607 |
| Billy Bob | 232 Highway | Atlanta | GA | 33450 |
Sheet3 looks like this....
| Name | Address | City | State | Zip |
| Fred Mastro | 13324 Lane | Honolulu | HI | 45612 |
| Brain Chris | 845 Thatway | Miami | FL | 12345 |
| Dan April | 232 ByWay | Washington | DC | 78464 |
| Jane See | 3222 Flower | Howell | NJ | 99706 |
The idea was to combine Sheet2, and Sheet3 into Sheet1 so that Sheet1 is the combined rows of both sheets. Then later be able to add say Sheet4 with more data and show it as well on Sheet1.
Sheet1 would look like this basically.....
| Name | Address | City | State | Zip |
| Bob Joe | 1234 Kingly | Tampa | FL | 33647 |
| Jane Doe | 352 Thisway | Clearwater | FL | 33607 |
| Billy Bob | 232 Highway | Atlanta | GA | 33450 |
| Fred Mastro | 13324 Lane | Honolulu | HI | 45612 |
| Brain Chris | 845 Thatway | Miami | FL | 12345 |
| Dan April | 232 ByWay | Washington | DC | 78464 |
| Jane See | 3222 Flower | Howell | NJ | 99706 |
Easy way of doing this? At first glance you would suspect yes. Maybe I do not know all the Excel functions possible, I'm sure an Excel Guru maybe could. Upon searching the Internet I found many "add-ins" created by people to perform this function.
So I thought I'd save someone the trouble, here's a macro/vba code you could use in your excel sheet. Most common problem when using this? Not having Macro's Enabled. Please make sure Macros are enabled for your workbook, and close and re-open excel after making the needed changes.
So in excel you'd have to find your VBA code. I'm using Excel 2007 so you have to show the developer tab first. Use help to find the Developer tab or View Code.
The event I used was Sheet1 Worksheet_Activate. So on activate of Sheet1 the code runs.
Private Sub Worksheet_Activate() End Sub
Then you can paste this function, this is the heart of it. There a better way to write this? I'm sure there is, as I never work in creating VBA macros for Excel, this was my first run through. The last time I did VBA was with Access about 10 years ago.
Sub ConsolidateRows(ByVal SourceSheet As Worksheet, ByVal DestinationSheet As Worksheet, ByVal TotalColumns As Integer, Optional SkipFirstRow As Boolean = False)
Dim SourceSheetRowCount As Integer
Dim DestinationSheetRowCount As Integer
Dim FoundDataInColumns As Boolean
SourceSheetRowCount = 1
If SkipFirstRow = True Then SourceSheetRowCount = 2
DestinationSheetRowCount = 1
FoundDataInColumns = False
'Loop Through Every Source Sheet Row
Do Until SourceSheetRowCount = SourceSheet.Rows.Count
'Check Each Row for Data In First Cell
If SourceSheet.Cells(SourceSheetRowCount, 1) = "" Then
'If No Data In First Cell, Lets Check Rest of Cells In This Row
For C = 2 To TotalColumns
If SourceSheet.Cells(SourceSheetRowCount, C) <> "" Then
'Data Was Found In A Cell
FoundDataInColumns = True
Else
FoundDataInColumns = False
End If
If FoundDataInColumns = True Then Exit For 'Data Found so Exit For, No Need To Check Rest of Cells
Next
If FoundDataInColumns = False Then Exit Do ' Data Was Not Found In Any of the Cells, so Exit Loop Completely, This Row is Empty
Else
FoundDataInColumns = True
End If
'If data was found, lets move on
If FoundDataInColumns = True Then
'Lets skip through rows that already have data on the DestinationSheet
Do Until DestinationSheet.Cells(DestinationSheetRowCount, 1) = ""
DestinationSheetRowCount = DestinationSheetRowCount + 1
Loop
'Now lets loop through the cells for this row and copy the data over
For C = 1 To TotalColumns
DestinationSheet.Cells(DestinationSheetRowCount, C) = SourceSheet.Cells(SourceSheetRowCount, C)
'Could copy formatting here
Next
DestinationSheetRowCount = DestinationSheetRowCount + 1
End If
SourceSheetRowCount = SourceSheetRowCount + 1
FoundDataInColumns = False
Loop
End Sub
Now you could call this directly for each sheet you wanted to import into the master...
Call ConsolidateRows(Sheet2, Sheet1, 14) Call ConsolidateRows(Sheet3, Sheet1, 14)
So after this, my friend was adding sheets, so I said, let me write a quick function to do all the sheets for you. So this function just loops through all the sheets and adds them to the destination one. Nothing fancy.
Sub ConsolidateAllSheetsTo(ByVal DestinationSheetName As String, ByVal DestinationSheet As Worksheet, ByVal TotalColumns As Integer)
Dim Sheet As Worksheet
Dim I As Integer
I = 1
For Each Sheet In ThisWorkbook.Worksheets
If Sheet.Name <> DestinationSheetName Then
If I = 1 Then
Call ConsolidateRows(Sheet, DestinationSheet, TotalColumns)
Else
Call ConsolidateRows(Sheet, DestinationSheet, TotalColumns, True)
End If
I = I + 1
End If
Next
End Sub
And so then you can stop calling the ConsolidateRows directly and instead call ColsolidateAllSheetsTo instead.
Call ConsolidateAllSheetsTo("Master", Sheet1, 14)
Yes, yes I know "Call" is old school and you don't need it. I just use it because it makes for faster skimming of code when I'm trying to debug.
So in the end, your activate event might look something like this...
Private Sub Worksheet_Activate() Sheet1.Cells.Delete Call ConsolidateAllSheetsTo("Master", Sheet1, 14) End Sub
Complete Code from Top to Bottom:
1: Private Sub Worksheet_Activate()
2: Sheet1.Cells.Delete
3: Call ConsolidateAllSheetsTo("Master", Sheet1, 14)
4: End Sub
5:
6: Sub ConsolidateAllSheetsTo(ByVal DestinationSheetName As String, ByVal DestinationSheet As Worksheet, ByVal TotalColumns As Integer)
7: Dim Sheet As Worksheet
8: Dim I As Integer
9: I = 1
10: For Each Sheet In ThisWorkbook.Worksheets
11: If Sheet.Name <> DestinationSheetName Then
12: If I = 1 Then
13: Call ConsolidateRows(Sheet, DestinationSheet, TotalColumns)
14: Else
15: Call ConsolidateRows(Sheet, DestinationSheet, TotalColumns, True)
16: End If
17: I = I + 1
18: End If
19: Next
20: End Sub
21:
22:
23: Sub ConsolidateRows(ByVal SourceSheet As Worksheet, ByVal DestinationSheet As Worksheet, ByVal TotalColumns As Integer, Optional SkipFirstRow As Boolean = False)
24: Dim SourceSheetRowCount As Integer
25: Dim DestinationSheetRowCount As Integer
26: Dim FoundDataInColumns As Boolean
27: SourceSheetRowCount = 1
28: If SkipFirstRow = True Then SourceSheetRowCount = 2
29: DestinationSheetRowCount = 1
30: FoundDataInColumns = False
31:
32: 'Loop Through Every Source Sheet Row
33: Do Until SourceSheetRowCount = SourceSheet.Rows.Count
34: 'Check Each Row for Data In First Cell
35: If SourceSheet.Cells(SourceSheetRowCount, 1) = "" Then
36: 'If No Data In First Cell, Lets Check Rest of Cells In This Row
37: For C = 2 To TotalColumns
38: If SourceSheet.Cells(SourceSheetRowCount, C) <> "" Then
39: 'Data Was Found In A Cell
40: FoundDataInColumns = True
41: Else
42: FoundDataInColumns = False
43: End If
44: If FoundDataInColumns = True Then Exit For 'Data Found so Exit For, No Need To Check Rest of Cells
45: Next
46: If FoundDataInColumns = False Then Exit Do ' Data Was Not Found In Any of the Cells, so Exit Loop Completely, This Row is Empty
47: Else
48: FoundDataInColumns = True
49: End If
50: 'If data was found, lets move on
51: If FoundDataInColumns = True Then
52: 'Lets skip through rows that already have data on the DestinationSheet
53: Do Until DestinationSheet.Cells(DestinationSheetRowCount, 1) = ""
54: DestinationSheetRowCount = DestinationSheetRowCount + 1
55: Loop
56: 'Now lets loop through the cells for this row and copy the data over
57: For C = 1 To TotalColumns
58: DestinationSheet.Cells(DestinationSheetRowCount, C) = SourceSheet.Cells(SourceSheetRowCount, C)
59: 'Could copy formatting here
60: Next
61: DestinationSheetRowCount = DestinationSheetRowCount + 1
62: End If
63: SourceSheetRowCount = SourceSheetRowCount + 1
64: FoundDataInColumns = False
65: Loop
66: End Sub
So there you have it, my quickly rigged consolidate function. Does it have bugs? Of course! It was free and quick.
Wexelblat's Scheduling Algorithm:
Choose Two:
- Good
- Fast
- Cheap
So you can see by this.. it was Fast and Free, so = No Good. haha.
Known Issue, I don't think these are bugs, just things I didn't code for.
-Your Source Sheets can not have blank rows between data. Code will stop at first blank row and go to next sheet -Your source sheets have to have data in the first column, otherwise it gets overwritten on the master
That's all I know of so far.
Good luck, hope this helps someone out there, 5 years from now.