Screwy sort by increments

Mogulnut

New Member
Joined
Mar 21, 2004
Messages
4
Book1
ABCD
1DataRun1Run2
2Information11
3Information27
4Information313
5Information419
6Information525
7Information631
8Information737
9Information843
10Information949
11Information1055
12Information112
13Information128
14Information1314
15Information1420
16Information1526
17Information1632
18Information1738
19Information1844
20Information1950
21Information2056
22Information213
23Information229
24Information2315
25Information2421
26Information2527
27Information2633
28Information2739
29Information2845
Sheet1


The above is an example of data that I need manipulated. The "Run1" column is just a count of the number of rows. The "Run2" column is in increments of 6 to be sorted later in ascending order. I need some code to have the "Run2" sequence stop when the 1st section (1 to 7) is less than or equal to the number of rows. I manipulate many files per day this way and the number of rows is never the same.

Thanks in advance.
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
First, enter the following formula into cell D1:
=COUNTA(B:B)-1

Then try a macro like this:

Sub macro()
Range("C3").Select
Check1 = Range("D1").Value
Check2 = ActiveCell.Offset(-1, 0) + 6
Do While Check2 < Check1
Check1 = Range("D1").Value
Check2 = ActiveCell.Offset(-1, 0) + 6
ActiveCell.Value = Check2
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Is that what you want?
 
Upvote 0
Not quite what I'm looking for. My mistake though. What I need is for the code to autofill the "run2" column from 1 to the number that is less than or equal to the total number of rows.
 
Upvote 0
To fill down to the last row:

Code:
Sub Macro4()
Range("D1").Select
ActiveCell.FormulaR1C1 = "=COUNTA(C[-2])"
RowNumber = ActiveCell.Value
Selection.ClearContents
    Range("C2:C3").Select
    Selection.AutoFill Destination:=Range("C2:C" & RowNumber), Type:=xlFillDefault
End Sub

Not the neatest way, but will work.

Also, I am not sure why you need "Run1" if it is just a count of rows.
:biggrin:
 
Upvote 0
The reason that I need row one is to resort the data back to it's original order with to be used at a later time without having multiple files kicking around.
 
Upvote 0
Welcome to the board, and try --

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> SixPack()

<SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, j <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, StartNum <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, LastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> MySheet <SPAN style="color:#00007F">As</SPAN> Worksheet

<SPAN style="color:#007F00">' // Change Sheet1 below to your //</SPAN>
<SPAN style="color:#007F00">' // worksheet name, or to the   //</SPAN>
<SPAN style="color:#007F00">' // Sheets(1) syntax to refer   //</SPAN>
<SPAN style="color:#007F00">' // to the 1st sheet in any WB. //</SPAN>
<SPAN style="color:#00007F">Set</SPAN> MySheet = Worksheets("Sheet1")
StartNum = 1

<SPAN style="color:#00007F">With</SPAN> MySheet
    LastRow = .[A65536].End(xlUp).Row
    Range("B:C").ClearContents
    <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> LastRow <SPAN style="color:#00007F">Step</SPAN> 10
        <SPAN style="color:#00007F">For</SPAN> j = 0 <SPAN style="color:#00007F">To</SPAN> 9
            <SPAN style="color:#00007F">If</SPAN> (i + j) <= LastRow <SPAN style="color:#00007F">Then</SPAN>
                .Cells(i + j, 2) = i + j
                .Cells(i + j, 3) = StartNum + (j * 6)
            <SPAN style="color:#00007F">Else</SPAN>
                <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">For</SPAN>
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
        <SPAN style="color:#00007F">Next</SPAN> j
        StartNum = StartNum + 1
    <SPAN style="color:#00007F">Next</SPAN> i
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>

<SPAN style="color:#00007F">Set</SPAN> MySheet = <SPAN style="color:#00007F">Nothing</SPAN>

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>

Edit: Added comment.
 
Upvote 0
Thanks Jon. That's closer to what I need, but not quite. Again I left something out. With the "Run2" column being in increments of 6. There are a maximum of 6 sections. For example, the first section would be 1&7, then 2&8 and so on with the last section in the run being 6&12. If I had 60 records, would need the sections to be less than or equal to 60. If I had 240 records, I would need each section to less than or equal to 240. The reason I am doing this is to merge the data into a word document so that every 6th record is in a stack.
 
Upvote 0
Can you use a formula solution? If so, this seems to work for me:
Book3
ABCD
1DataRun1Run2
2Info11
3Info27
4Info313
5Info419
6Info525
7Info631
8Info737
9Info843
10Info949
11Info1055
12Info112
13Info128
14Info1314
15Info1420
16Info1526
17Info1632
18Info1738
19Info1844
20Info1950
21Info2056
22Info213
23Info229
24Info2315
25Info2421
26Info2527
27Info2633
28Info2739
29Info2845
Sheet1


You can paste special over the formulas once completed if you need to sort.
 
Upvote 0
If 74 records should procude increments of 12, with records 73 and 74 being tagged as 7 and 19, then --

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> SixPack()

<SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, j <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, StartNum <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, LastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> Increment <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> MySheet <SPAN style="color:#00007F">As</SPAN> Worksheet

<SPAN style="color:#007F00">' // Change Sheet1 below to your //</SPAN>
<SPAN style="color:#007F00">' // worksheet name, or to the   //</SPAN>
<SPAN style="color:#007F00">' // Sheets(1) syntax to refer   //</SPAN>
<SPAN style="color:#007F00">' // to the 1st sheet in any WB. //</SPAN>
<SPAN style="color:#00007F">Set</SPAN> MySheet = Worksheets("Sheet1")
StartNum = 1

<SPAN style="color:#00007F">With</SPAN> MySheet
    LastRow = .[A65536].End(xlUp).Row
    Increment = Int(LastRow / 6)
    Range("B:C").ClearContents
    <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> LastRow <SPAN style="color:#00007F">Step</SPAN> Increment
        <SPAN style="color:#00007F">For</SPAN> j = 0 <SPAN style="color:#00007F">To</SPAN> (Increment - 1)
            <SPAN style="color:#00007F">If</SPAN> (i + j) <= LastRow <SPAN style="color:#00007F">Then</SPAN>
                .Cells(i + j, 2) = i + j
                .Cells(i + j, 3) = StartNum + (j * Increment)
            <SPAN style="color:#00007F">Else</SPAN>
                <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">For</SPAN>
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
        <SPAN style="color:#00007F">Next</SPAN> j
        StartNum = StartNum + 1
    <SPAN style="color:#00007F">Next</SPAN> i
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>

<SPAN style="color:#00007F">Set</SPAN> MySheet = <SPAN style="color:#00007F">Nothing</SPAN>

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>

Closer?
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

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