I have a table that looks like this.
<tbody>
</tbody>
My problem I'm trying to solve for is to have a macro run that will take specified cells in a row (dealer information) and duplicate to a new row for each building that is listed in the columns. My table only shows 2 building data sets, however my actual spreadsheet holds 15. If building columns are left blank, I want the macro to skip to the next entry. Here is what I'd like the above data to look like:
<tbody>
</tbody>
So as you can see, it's a bit complicated in the sense that certain cells within a row need to repeat, columns need to split into new rows, blanks need to be ignored, and certain columns can also be ignored. I'm very new to VBA, so I've been doing a lot of research and have found the following solution works, but I cannot manipulate it enough to get the outcome desired. Any help is greatly greatly appreciated!! Thanks in advance!
Here is what I've been trying to manipulate:
Sub ShrinkTable()
Dim maxRows As Double
Dim maxCols As Integer
Dim data As Variant maxRows = Cells(1, 1).End(xlDown).row
maxCols = Cells(1, 1).End(xlToRight).Column data = Range(Cells(1, 1), Cells(maxRows, maxCols))
Dim newSht As Worksheet
Set newSht = Sheets.Add
With newSht
.Cells(1, 1).Value = "Name"
.Cells(1, 2).Value = "Column"
Dim writeRow As Double writeRow = 2
Dim row As Double
row = 2
Dim col As Integer
Do While True
col = 2
Do While True
If data(row, col) = "" Then Exit Do 'Skip Blanks
'Name
.Cells(writeRow, 1).Value = data(row, 1)
'Language
.Cells(writeRow, 2).Value = data(row, col)
writeRow = writeRow + 1
If col = maxCols Then Exit Do 'Exit clause
col = col + 1
Loop
If row = maxRows Then Exit Do 'exit clause
row = row + 1
Loop
End With
End Sub
EXAMPLE:
| A | B | C | D |
+-------+------------+------------+------------+
1 | Name | Language 1 | Language 2 | Language 3 |
+=======+============+============+============+
2 | John | English | Chinese | Spanish |
3 | Wendy | Chinese | French | English |
4 | Peter | Spanish | Chinese | English |<br><br>And I want to generate a table that has only one language column. The other two language columns should become new rows like this:
| A | B |
+-------+----------+
1 | Name | Language |
+=======+==========+
2 | John | English |
3 | John | Chinese |
4 | John | Spanish |
5 | Wendy | Chinese |
6 | Wendy | French |
7 | Wendy | English |
8 | Peter | Spanish |
9 | Peter | Chinese |
10 | Peter | English |
| DealerName | DealerPhone | DealerAddress | DealerCity | DealerState | DealerZip | DealerEmail | BuildingName1 | BuildingAddress1 | BuildingCity1 | BuildingState1 | BuildingZip1 | BuildingName2 | BuildingAddress2 | BuildingCity2 | BuildingState2 | BuildingZip2 | UnneededColumn1 | Date | UnneededColumn2 | UnneededColumn3 | CorpID |
| PD Consulting | 555-555-5555 | 1234 Consulting Drive | Cleveland | OH | 44145 | consulting@email.com | PDBuilding1 | 111 Address Ave | Westlake | OH | 44145 | Consulting2 | 222 Address Dr | North Olmsted | OH | 44070 | xxx | 11/3/2014 | zzz | yyy | 12345 |
| Michel Wireless | 222-222-2222 | 2222 Wireless Way | Bay Village | OH | 44076 | wireless@email.com | WirelessBuilding1 | 111 Cell St | Solon | OH | 44139 | bbb | 10/3/2014 | rrr | ttt | 45677 |
<tbody>
</tbody>
My problem I'm trying to solve for is to have a macro run that will take specified cells in a row (dealer information) and duplicate to a new row for each building that is listed in the columns. My table only shows 2 building data sets, however my actual spreadsheet holds 15. If building columns are left blank, I want the macro to skip to the next entry. Here is what I'd like the above data to look like:
| Date | BuildingName | BuildingAddress | BuildingCity | BuildingState | BuildingZip | CorpID | DealerName | DealerAddress | DealerCity | DealerState | DealerZip | DealerEmail | DealerPhone |
| 11/3/2014 | PDBuilding1 | 111 Address Ave | Westlake | OH | 44145 | 12345 | PDConsulting | 1234 Consulting Drive | Cleveland | OH | 44145 | consulting@email.com | 555-555-5555 |
| 11/3/2014 | Consulting2 | 222 Address Dr | North Olmsted | OH | 44070 | 12345 | PDConsulting | 1234 Consulting Drive | Cleveland | OH | 44145 | consulting@email.com | 555-555-5555 |
| 10/3/2014 | WirelessBuilding1 | 111 Cell St | Solon | OH | 44139 | 45677 | Michel Wireless | 2222 Wireless Way | Bay Village | OH | 44076 | wireless@email.com | 222-222-2222 |
<tbody>
</tbody>
So as you can see, it's a bit complicated in the sense that certain cells within a row need to repeat, columns need to split into new rows, blanks need to be ignored, and certain columns can also be ignored. I'm very new to VBA, so I've been doing a lot of research and have found the following solution works, but I cannot manipulate it enough to get the outcome desired. Any help is greatly greatly appreciated!! Thanks in advance!
Here is what I've been trying to manipulate:
Sub ShrinkTable()
Dim maxRows As Double
Dim maxCols As Integer
Dim data As Variant maxRows = Cells(1, 1).End(xlDown).row
maxCols = Cells(1, 1).End(xlToRight).Column data = Range(Cells(1, 1), Cells(maxRows, maxCols))
Dim newSht As Worksheet
Set newSht = Sheets.Add
With newSht
.Cells(1, 1).Value = "Name"
.Cells(1, 2).Value = "Column"
Dim writeRow As Double writeRow = 2
Dim row As Double
row = 2
Dim col As Integer
Do While True
col = 2
Do While True
If data(row, col) = "" Then Exit Do 'Skip Blanks
'Name
.Cells(writeRow, 1).Value = data(row, 1)
'Language
.Cells(writeRow, 2).Value = data(row, col)
writeRow = writeRow + 1
If col = maxCols Then Exit Do 'Exit clause
col = col + 1
Loop
If row = maxRows Then Exit Do 'exit clause
row = row + 1
Loop
End With
End Sub
EXAMPLE:
| A | B | C | D |
+-------+------------+------------+------------+
1 | Name | Language 1 | Language 2 | Language 3 |
+=======+============+============+============+
2 | John | English | Chinese | Spanish |
3 | Wendy | Chinese | French | English |
4 | Peter | Spanish | Chinese | English |<br><br>And I want to generate a table that has only one language column. The other two language columns should become new rows like this:
| A | B |
+-------+----------+
1 | Name | Language |
+=======+==========+
2 | John | English |
3 | John | Chinese |
4 | John | Spanish |
5 | Wendy | Chinese |
6 | Wendy | French |
7 | Wendy | English |
8 | Peter | Spanish |
9 | Peter | Chinese |
10 | Peter | English |
Last edited:
