VBA - splitting cells with variable ranges into individual rows

[quercus]

Firstly, apologies as I couldn't manage to upload the excel sheet on here so I took a screen shot instead - link towards the bottom of the post

The example shows two tables, the table at the top is the data in it's current format, and below it is an example of how it needs to look.

Essentially, in column A there are street numbers which comprise a range, i.e. 1-3. I need to split each of these into an individual row, for example the row with 1-3 would turn into rows 1, 2 & 3 whilst retaining the data in the other columns. It's probably easier to look at the two examples given in the screenshot to understand this....

The main issue is that the ranges of data are not uniform, so the data does not go 1-3, 4-6 etc. Some cells may have a range of 2 others may have a range of 10.

This is a very large dataset and as such I think VBA is the only solution, although I am not entirely sure whether this can actually be done.

Screenshot:


I hope i have explained the scenario well enough to be understood, any suggestions on possible VBA would be much appreciated.

Thanks very much!
quercus

 

[Sandeep Warrier]

Hi

One possible way

Sub Test()
    Dim rng As Range, rCell As Range
    Dim Num1 As Long, Num2 As Long, lResize As Long
    Set rng = Range("A2:A4")
    For Each rCell In rng
        With rCell
            Num1 = CLng(Left$(.Value, InStr(.Value, "-") - 1))
            Num2 = CLng(Mid$(.Value, InStr(.Value, "-") + 1, Len(.Value)))
            lResize = Num2 - Num1 + 1
            Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Num1
            Range("A" & Rows.Count).End(xlUp).Resize(lResize).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
            Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(lResize).Value = .Offset(0, 1).Value
            Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(lResize).Value = .Offset(0, 2).Value
            Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(lResize).Value = .Offset(0, 3).Value
            Range("E" & Rows.Count).End(xlUp).Offset(1).Resize(lResize).Value = .Offset(0, 4).Value
        End With
    Next rCell
End Sub

<b>Excel 2010</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #BBB"><colgroup><col width="10px" style="background-color: #DAE7F5" /><col /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #DAE7F5;text-align: center;color: #161120"><th></th><th>A</th><th>B</th><th>C</th><th>D</th><th>E</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style="font-weight: bold;;">St Num</td><td style="font-weight: bold;;">St Name</td><td style="font-weight: bold;;">St Suffix</td><td style="font-weight: bold;;">X Co-ord</td><td style="font-weight: bold;;">Y Co-ord</td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style=";">24-26</td><td style=";">Smit</td><td style=";">Street</td><td style=";">23456789213 23</td><td style=";">6854651 456</td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style=";">156-166</td><td style=";">James</td><td style=";">Street</td><td style=";">44168654612 65468</td><td style=";">15654165 654163</td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style=";">16-24</td><td style=";">Yadda Yadda</td><td style=";">Street</td><td style=";">1685465131 6849876</td><td style=";">1654968321 87651</td></tr><tr ><td style="color: #161120;text-align: center;">5</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">6</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">7</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">8</td><td style="font-weight: bold;;">St Num</td><td style="font-weight: bold;;">St Name</td><td style="font-weight: bold;;">St Suffix</td><td style="font-weight: bold;;">X Co-ord</td><td style="font-weight: bold;;">Y Co-ord</td></tr><tr ><td style="color: #161120;text-align: center;">9</td><td style="text-align: right;;">24</td><td style=";">Smit</td><td style=";">Street</td><td style=";">23456789213 23</td><td style=";">6854651 456</td></tr><tr ><td style="color: #161120;text-align: center;">10</td><td style="text-align: right;;">25</td><td style=";">Smit</td><td style=";">Street</td><td style=";">23456789213 23</td><td style=";">6854651 456</td></tr><tr ><td style="color: #161120;text-align: center;">11</td><td style="text-align: right;;">26</td><td style=";">Smit</td><td style=";">Street</td><td style=";">23456789213 23</td><td style=";">6854651 456</td></tr><tr ><td style="color: #161120;text-align: center;">12</td><td style="text-align: right;;">156</td><td style=";">James</td><td style=";">Street</td><td style=";">44168654612 65468</td><td style=";">15654165 654163</td></tr><tr ><td style="color: #161120;text-align: center;">13</td><td style="text-align: right;;">157</td><td style=";">James</td><td style=";">Street</td><td style=";">44168654612 65468</td><td style=";">15654165 654163</td></tr><tr ><td style="color: #161120;text-align: center;">14</td><td style="text-align: right;;">158</td><td style=";">James</td><td style=";">Street</td><td style=";">44168654612 65468</td><td style=";">15654165 654163</td></tr><tr ><td style="color: #161120;text-align: center;">15</td><td style="text-align: right;;">159</td><td style=";">James</td><td style=";">Street</td><td style=";">44168654612 65468</td><td style=";">15654165 654163</td></tr><tr ><td style="color: #161120;text-align: center;">16</td><td style="text-align: right;;">160</td><td style=";">James</td><td style=";">Street</td><td style=";">44168654612 65468</td><td style=";">15654165 654163</td></tr><tr ><td style="color: #161120;text-align: center;">17</td><td style="text-align: right;;">161</td><td style=";">James</td><td style=";">Street</td><td style=";">44168654612 65468</td><td style=";">15654165 654163</td></tr><tr ><td style="color: #161120;text-align: center;">18</td><td style="text-align: right;;">162</td><td style=";">James</td><td style=";">Street</td><td style=";">44168654612 65468</td><td style=";">15654165 654163</td></tr><tr ><td style="color: #161120;text-align: center;">19</td><td style="text-align: right;;">163</td><td style=";">James</td><td style=";">Street</td><td style=";">44168654612 65468</td><td style=";">15654165 654163</td></tr><tr ><td style="color: #161120;text-align: center;">20</td><td style="text-align: right;;">164</td><td style=";">James</td><td style=";">Street</td><td style=";">44168654612 65468</td><td style=";">15654165 654163</td></tr><tr ><td style="color: #161120;text-align: center;">21</td><td style="text-align: right;;">165</td><td style=";">James</td><td style=";">Street</td><td style=";">44168654612 65468</td><td style=";">15654165 654163</td></tr><tr ><td style="color: #161120;text-align: center;">22</td><td style="text-align: right;;">166</td><td style=";">James</td><td style=";">Street</td><td style=";">44168654612 65468</td><td style=";">15654165 654163</td></tr><tr ><td style="color: #161120;text-align: center;">23</td><td style="text-align: right;;">16</td><td style=";">Yadda Yadda</td><td style=";">Street</td><td style=";">1685465131 6849876</td><td style=";">1654968321 87651</td></tr><tr ><td style="color: #161120;text-align: center;">24</td><td style="text-align: right;;">17</td><td style=";">Yadda Yadda</td><td style=";">Street</td><td style=";">1685465131 6849876</td><td style=";">1654968321 87651</td></tr><tr ><td style="color: #161120;text-align: center;">25</td><td style="text-align: right;;">18</td><td style=";">Yadda Yadda</td><td style=";">Street</td><td style=";">1685465131 6849876</td><td style=";">1654968321 87651</td></tr><tr ><td style="color: #161120;text-align: center;">26</td><td style="text-align: right;;">19</td><td style=";">Yadda Yadda</td><td style=";">Street</td><td style=";">1685465131 6849876</td><td style=";">1654968321 87651</td></tr><tr ><td style="color: #161120;text-align: center;">27</td><td style="text-align: right;;">20</td><td style=";">Yadda Yadda</td><td style=";">Street</td><td style=";">1685465131 6849876</td><td style=";">1654968321 87651</td></tr><tr ><td style="color: #161120;text-align: center;">28</td><td style="text-align: right;;">21</td><td style=";">Yadda Yadda</td><td style=";">Street</td><td style=";">1685465131 6849876</td><td style=";">1654968321 87651</td></tr><tr ><td style="color: #161120;text-align: center;">29</td><td style="text-align: right;;">22</td><td style=";">Yadda Yadda</td><td style=";">Street</td><td style=";">1685465131 6849876</td><td style=";">1654968321 87651</td></tr><tr ><td style="color: #161120;text-align: center;">30</td><td style="text-align: right;;">23</td><td style=";">Yadda Yadda</td><td style=";">Street</td><td style=";">1685465131 6849876</td><td style=";">1654968321 87651</td></tr><tr ><td style="color: #161120;text-align: center;">31</td><td style="text-align: right;;">24</td><td style=";">Yadda Yadda</td><td style=";">Street</td><td style=";">1685465131 6849876</td><td style=";">1654968321 87651</td></tr></tbody></table><p style="width:3.6em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #BBB;border-top:none;text-align: center;background-color: #DAE7F5;color: #161120">Sheet1</p><br /><br />

 

[quercus]

Great - that's exactly the result I was after.

How would I adjust the code so that the data is exported onto a new worksheet?

Thanks!

 

[Sandeep Warrier]

Change

Set rng = Range(...)

to

Set rng = Sheets("Sheet1").Range(...) .....(use your relevant sheet name)

Then, in the For loop, change

Range("A" & Rows.Count).....

to

Sheets("Sheet2").Range("A" & Sheets("Sheet2").Rows.Count)..... .. and so on for all the ranges .....(use your relevant result sheet)