Convert Excel Range to Rows

R

raltam

New Member
Joined
Mar 10, 2018
Messages
9
Hello,I am trying to figure out a way to create one big master list that lists all of the accounts within the given range.

I have about 1000 rows with different variation of ranges (1st example below) and for each range listed below, I need to list each account within that range in column D and then getting it to do the same for each different range. For example, for my example below, the 1st range is from 70000 to 71000, I want to list all accounts within that range in column D (including the beginning and ending account rage). So for the 1st range, I should ultimately have 1000 rows and continue on for every range there after. If the range is 70000 to 70001 then it would list two object accounts and so on. I think you guys get the point.

At the end I would end up with four columns like in the second example below and will have thousands of rows for the different ranges.

I started doing this manually and trying some IF scenarios, but I haven't been successful and this would obviously take me forever to do it manually.

Any help is greatly appreciated. I did look around and I didn't quite find something that would help me with this, so thanks in advance for your help!!



[TABLE="width: 500, align: left"]
<tbody>[TR]
[TD]Key
(Col A)
[/TD]
[TD]Account From
(Col B)
[/TD]
[TD]Account To
(Col C)
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]70000 :71000
[/TD]
[TD]70000
[/TD]
[TD]71000
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]
[TABLE="width: 73"]
<tbody>[TR]
[TD]72000 :74000
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]72000
[/TD]
[TD]74000
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]72000 :74900
[/TD]
[TD]72000
[/TD]
[TD]74900
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Key
(A)
[/TD]
[TD]Account From
(B)
[/TD]
[TD]Account To
(C)
[/TD]
[TD]List Each Account
(D)
[/TD]
[/TR]
[TR]
[TD]70000 :71000
[/TD]
[TD]70000
[/TD]
[TD]71000
[/TD]
[TD]70000
[/TD]
[/TR]
[TR]
[TD]70000 :71000
[/TD]
[TD]70000
[/TD]
[TD]71000
[/TD]
[TD]70001
[/TD]
[/TR]
[TR]
[TD]70000 :71000
[/TD]
[TD]70000
[/TD]
[TD]71000
[/TD]
[TD]70002
[/TD]
[/TR]
[TR]
[TD]70000 :71000
[/TD]
[TD]70000
[/TD]
[TD]71000
[/TD]
[TD]70003
[/TD]
[/TR]
[TR]
[TD]70000 :71000
[/TD]
[TD]70000
[/TD]
[TD]71000
[/TD]
[TD]70004
[/TD]
[/TR]
[TR]
[TD]70000 :71000
[/TD]
[TD]70000
[/TD]
[TD]71000
[/TD]
[TD]70005
[/TD]
[/TR]
[TR]
[TD]70000 :71000
[/TD]
[TD]70000
[/TD]
[TD]71000
[/TD]
[TD]70006
[/TD]
[/TR]
[TR]
[TD]70000 :71000
[/TD]
[TD]70000
[/TD]
[TD]71000
[/TD]
[TD]70007
[/TD]
[/TR]
[TR]
[TD]70000 :71000
[/TD]
[TD]70000
[/TD]
[TD]71000
[/TD]
[TD]70008
[/TD]
[/TR]
</tbody>[/TABLE]
 
Sort by date Sort by votes
Dryver14 said:
If you want to stick with code just do as it states above, yes I could probably replace the code if I understood where your list of requirements are and how they look on the sheet
Click to expand...

I will try this also.... I sent you a PM also. Thank you!
 
Upvote 0

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
this splits it out into columns D,E,F and G

Code: 
Sub KWCreateManyNumbers()




    Dim TopNumber As Long
    Dim BottomNumber As Long
    Dim i As Long
    Dim NextRow As Long
    Dim a As Long
    Dim LastRow As Long
    
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    NextRow = Cells(Rows.Count, 7).End(xlUp).Row + 1
    
    For a = 2 To LastRow
        TopNumber = ActiveSheet.Cells(a, 2).Value
        BottomNumber = ActiveSheet.Cells(a, 3).Value
    
        Cells(NextRow, 7).Select
    
        For i = TopNumber To BottomNumber
            Cells(NextRow, 7) = i
            Cells(NextRow, 4) = TopNumber & " " & ":" & " " & BottomNumber
            Cells(NextRow, 5) = TopNumber
            Cells(NextRow, 6) = BottomNumber
            NextRow = NextRow + 1
        Next i
    Next a
    
End Sub
 
Upvote 0
By the way,

There is no error handling in this procedure. I did notice about 6 lines down on column c you only have 3 digits, the macro would fail if the number is not equal to or more than the previous number
 
Upvote 0
With some error handling

Code: 
KWCreateManyNumbers()




    Dim TopNumber As Long
    Dim BottomNumber As Long
    Dim i As Long
    Dim NextRow As Long
    Dim a As Long
    Dim LastRow As Long
    
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    NextRow = Cells(Rows.Count, 7).End(xlUp).Row + 1
    
    For a = 2 To LastRow
        TopNumber = ActiveSheet.Cells(a, 2).Value
        BottomNumber = ActiveSheet.Cells(a, 3).Value
    
        Cells(NextRow, 7).Select
        If BottomNumber < TopNumber Then
            BottomNumber = InputBox(Prompt:="TopNumber is " & TopNumber & " Bottomnumber is " & BottomNumber & " Please enter a valid Bottom Number", Title:="Number is less than start number")
        End If
        For i = TopNumber To BottomNumber
            Cells(NextRow, 7) = i
            Cells(NextRow, 4) = TopNumber & " " & ":" & " " & BottomNumber
            Cells(NextRow, 5) = TopNumber
            Cells(NextRow, 6) = BottomNumber
            NextRow = NextRow + 1
        Next i
    Next a
    
End Sub
 
Upvote 0
Ok I'm looking at the file now. Was this scanned/converted with OCR? Some of the ranges seem off as Dryver14 observed (e.g. 99381 :99331)
 
Upvote 0
They will vary.... It's not always 7 series, but most of them will be in the 70000 range..
 
Last edited:
Upvote 0
There's way too much data for a formula, so I also wrote some code:

Code: 
Sub expandrange1()
Dim myarray1(), myarray2(), myarray3(), i As Long, j%, x As Long, lr%, diff%
lr = Cells(Rows.Count, 1).End(xlUp).Row
x = 0
For i = 2 To lr
diff = Cells(i, 3) - Cells(i, 2)
For j = 0 To diff
ReDim Preserve myarray1(x)
ReDim Preserve myarray2(x)
myarray1(x) = Cells(i, 1)
myarray2(x) = Cells(i, 2) + j
x = x + 1
Next j
Next i
ReDim myarray3(x, 0)
ReDim myarray3(x, 1)
For i = 0 To UBound(myarray1)
myarray3(i, 0) = myarray1(i)
myarray3(i, 1) = myarray2(i)
Next
Range("e2:f2").Resize(UBound(myarray3) + 1) = myarray3
End Sub

Before running, get rid of the negative differences by adding a column with this formula copied down:

=IF(C2>=B2,C2,B2)

and paste it back to column C

(or if they're not errors but backwards switch them around)
 
Last edited:
Upvote 0
Shorter code:

Code: 
Sub expandrange2()
Dim myarray3(), i As Long, j%, x As Long, lr%, diff%, sumdiff As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
sumdiff = Application.Sum(Range("c2").Resize(lr)) - Application.Sum(Range("b2").Resize(lr)) + lr - 1
ReDim myarray3(0 To sumdiff, 0 To 1)
x = 0
For i = 2 To lr
diff = Cells(i, 3) - Cells(i, 2)
For j = 0 To diff
myarray3(x, 0) = Cells(i, 1)
myarray3(x, 1) = Cells(i, 2) + j
x = x + 1
Next j
Next i
Range("e2:f2").Resize(UBound(myarray3) + 1) = myarray3
End Sub
 
Upvote 0
sheetspread said:
There's way too much data for a formula, so I also wrote some code:

Code: 
Sub expandrange1()
Dim myarray1(), myarray2(), myarray3(), i As Long, j%, x As Long, lr%, diff%
lr = Cells(Rows.Count, 1).End(xlUp).Row
x = 0
For i = 2 To lr
diff = Cells(i, 3) - Cells(i, 2)
For j = 0 To diff
ReDim Preserve myarray1(x)
ReDim Preserve myarray2(x)
myarray1(x) = Cells(i, 1)
myarray2(x) = Cells(i, 2) + j
x = x + 1
Next j
Next i
ReDim myarray3(x, 0)
ReDim myarray3(x, 1)
For i = 0 To UBound(myarray1)
myarray3(i, 0) = myarray1(i)
myarray3(i, 1) = myarray2(i)
Next
Range("e2:f2").Resize(UBound(myarray3) + 1) = myarray3
End Sub

Before running, get rid of the negative differences by adding a column with this formula copied down:

=IF(C2>=B2,C2,B2)

and paste it back to column C

(or if they're not errors but backwards switch them around)
Click to expand...


Sheetspread and Dryver14..... You are awesome!!! Thank you soooo much for your help!

I tried it with a few ranges and they both work like a charm!!! Thanks again for your time and help!!!! It looks like I have to run them separate times because I am exceeding 100k rows with the first 245 ranges, but that's a million times better than having to do this manually!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
Possible to pull apart 1st section of string for date & time
2 3
Replies
23
Views
450
Peter_SSs
Peter_SSs
U
  • Solved
Doing a search for text within a call, from entries in a defined name range
Replies
3
Views
110
Upex
U
A
  • Question Question
Find and Replace Value in List Named Range Reference
Replies
0
Views
548
arembr01
A
Guybrush Threepwood
  • Question Question
Using Filter for Criteria in Multiple Columns and a Specific Row Range?
Replies
0
Views
420
Guybrush Threepwood
Guybrush Threepwood
D
  • Question Question
Generating Reports in Word Using Data in Excel
Replies
1
Views
338
Dan_W
D

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top