Offset output EIGHT columns to the right after it reaches a set number of rows.

S.H.A.D.O.

Well-known Member
Joined
Sep 6, 2005
Messages
1,915
The code below was written by pgc01 which I found while doing a search on this forum.
What I would like is for once the output gets to say 10,000 rows it stops and moves EIGHT columns to the right and then continues, and it keeps doing this until the code finishes processing please.
Here is the code:

Code:
Sub Combinations()
    Dim rRng As Range, p
    Dim vElements, lRow As Long, vResult As Variant, vResults As Variant
    vElements = VBA.Array("01", "02", "03", "04", "05", "06", "07", "08", "09", _
                          "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", _
                          "20", "21", "22", "23", "24")
    p = 6
    ReDim vResult(0 To p - 1)
    ReDim vResults(1 To Application.WorksheetFunction.Combin(UBound(vElements) + 1, p), 1 To 1)
    Call CombinationsNP(vElements, CInt(p), vResult, vResults, lRow, 0, 0)
'   The combinations are in vResults. For ex. write it to the WorkSheet.
    Range("A1").Resize(UBound(vResults)) = vResults
End Sub
 
Sub CombinationsNP(vElements As Variant, p As Integer, vResult As Variant, vResults, lRow As Long, _
                   iElement As Integer, iIndex As Integer)
    Dim i As Integer
    For i = iElement To UBound(vElements)
        vResult(iIndex) = vElements(i)
        If iIndex = p - 1 Then
            lRow = lRow + 1
            vResults(lRow, 1) = Join(vResult, ",")
        Else
            Call CombinationsNP(vElements, p, vResult, vResults, lRow, i + 1, iIndex + 1)
        End If
    Next i
End Sub

Thanks in advance.
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
With apologies to PGC01 :-
Try this:-
Code:
Sub Combinations()
    Dim rRng As Range, p
    Dim nArray
    Dim vElements, c As Long, lRow As Long, vResult As Variant, vResults As Variant
    vElements = VBA.Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12", _
    "13", "14", "15", "16", "17", "18", "19", "20", "21", _
    "22", "23", "24")
    p = 6
    ReDim vResult(0 To p - 1)
    ReDim vResults(1 To Application.WorksheetFunction.Combin(UBound(vElements) + 1, p), 1 To 1)
    ReDim nArray(1 To UBound(vResults) - 10000, 1 To 1)
    
    Call CombinationsNP(vElements, nArray, c, CInt(p), vResult, vResults, lRow, 0, 0)
'   The combinations are in vResults. For ex. write it to the WorkSheet.
    Range("A1").Resize(UBound(vResults), 1) = vResults
    Range("H10001").Resize(UBound(nArray), 1) = nArray
End Sub
 
Sub CombinationsNP(vElements As Variant, nArray As Variant, c, p As Integer, vResult As Variant, vResults, lRow As Long, _
                   iElement As Integer, iIndex As Integer)
    Dim i As Integer
    
    For i = iElement To UBound(vElements)
        vResult(iIndex) = vElements(i)
        If iIndex = p - 1 Then
            lRow = lRow + 1
            
            If lRow > 10000 Then
               c = c + 1
               nArray(c, 1) = Join(vResult, ",")
            Else
                vResults(lRow, 1) = Join(vResult, ",")
             End If
        Else
            Call CombinationsNP(vElements, nArray, c, p, vResult, vResults, lRow, i + 1, iIndex + 1)
        End If
    Next i
End Sub
 
Upvote 0
Thanks for the reply MickG,

The thing is that the output might need to move EIGHT columns to the right several times before the code fininshes processing.
Your code stops at line 10,000 and then moves EIGHT columns to the right but starts again in cell 10,001.
I have tried several things but can't seem to get it to work.
I thought something like:
Code:
Sub Combinations1()
    Dim rRng As Range, p
    Dim nArray
    Dim vElements, c As Long, lRow As Long, vResult As Variant, vResults As Variant
    vElements = VBA.Array("01", "02", "03", "04", "05", "06", "07", "08", "09", _
                          "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", _
                          "20", "21", "22", "23", "24")
    p = 6
    ReDim vResult(0 To p - 1)
    ReDim vResults(1 To Application.WorksheetFunction.Combin(UBound(vElements) + 1, p), 1 To 1)
    ReDim nArray(1 To UBound(vResults) - 10000, 1 To 1)
    
    Call CombinationsNP(vElements, nArray, c, CInt(p), vResult, vResults, lRow, 0, 0)
'   The combinations are in vResults. For ex. write it to the WorkSheet.
    Range("A1").Resize(UBound(vResults), 1) = vResults
    Range("H10001").Resize(UBound(nArray), 1) = nArray
End Sub
 
Sub CombinationsNP(vElements As Variant, nArray As Variant, c, p As Integer, vResult As Variant, vResults, lRow As Long, _
                   iElement As Integer, iIndex As Integer)
    Dim i As Integer
    
    Dim myWrap As Long ' <<<<<<<<<<<<<<<<<<<<<<<<<
    myWrap = 10000 ' <<<<<<<<<<<<<<<<<<<<<<
    
    For i = iElement To UBound(vElements)
        vResult(iIndex) = vElements(i)
        If iIndex = p - 1 Then
            lRow = lRow + 1
            
            If lRow > myWrap Then ' <<<<<<<<<<<<<<<<<<<<<<<<
               ActiveCell.Offset(lRow - myWrap, 8).Select ' <<<<<<<<<<<<<<<<<
            Else
                vResults(lRow, 1) = Join(vResult, ",")
            End If
            
        Else
            Call CombinationsNP(vElements, nArray, c, p, vResult, vResults, lRow, i + 1, iIndex + 1)
        End If
    Next i
End Sub

Thanks in advance.
 
Upvote 0
Hi S.H.A.D.O.
I tried writing a cut and paste loop to do what you want and it locked up my computer, so I won't be offering that to you. It was doing it ok, but after about the fourth column it hung up and indicated a memory problem. Maybe somebody else has a better solution than copy and paste.
 
Upvote 0
Thanks anyway JLGWhiz for taking the time to read my post and attempting to resolve my request, it is appreciated.
 
Upvote 0
Well I have tried many different variations but without any success unfortunately.
This is what I have got, the bit changed from the original code is between the asterix.

Code:
Sub Combinations()
    Dim rRng As Range, p
    Dim vElements, lRow As Long, vResult As Variant, vResults As Variant
    vElements = VBA.Array("01", "02", "03", "04", "05", "06", "07", "08", "09", _
                          "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", _
                          "20", "21", "22", "23", "24")
    p = 6
    ReDim vResult(0 To p - 1)
    ReDim vResults(1 To Application.WorksheetFunction.Combin(UBound(vElements) + 1, p), 1 To 1)
    Call CombinationsNP(vElements, CInt(p), vResult, vResults, lRow, 0, 0)
'   The combinations are in vResults. For ex. write it to the WorkSheet.
    Range("A1").Resize(UBound(vResults)) = vResults
End Sub
 
Sub CombinationsNP(vElements As Variant, p As Integer, vResult As Variant, vResults, lRow As Long, _
                   iElement As Integer, iIndex As Integer)
    Dim i As Integer
    For i = iElement To UBound(vElements)
        vResult(iIndex) = vElements(i)
        If iIndex = p - 1 Then
            lRow = lRow + 1

'**********************************************************
            
            If lRow > 100 Then
                lRow = 1
                ActiveCell.Offset(-100, 8).Select
            Else
                vResults(lRow, 1) = Join(vResult, ",")
            End If
            
'**********************************************************
            
        Else
            Call CombinationsNP(vElements, p, vResult, vResults, lRow, i + 1, iIndex + 1)
        End If
    Next i
End Sub

Thanks in advance.
 
Upvote 0
Can you explain:-
I thought you wanted all data after row 10000 to be 8 columns to the right.
Is it that you want every Tenthousanth ROW to be 8 columns to the right???
I think you could do this in various ways:-

1) Write some code to move the related data Rows, after the main code has run.
2) Increase the size of the original Array "vResults" to have eight columns.
This would be no good if you had other data within those eight columns as it would leave them blank.
3) You could also add an array in the code for the column 8 data, to run within the original code, much like my altered code.
 
Upvote 0
Thanks for the reply MickG,

If I change the array to say 30 numbers there will NOT be enough rows to output the data.
So what I want it to do is to output say the first 10,000 rows and then move right EIGHT columns and then output the next 10,000 rows and then move right EIGHT columns and then output the next 10,000 rows and so on until ALL output is fininshed. This could mean moving RIGHT EIGHT columns several times, but always going to ROW 1 in the eighth column and continuing. There will be nothing in any of the other columns.
Thanks in advance.
 
Upvote 0
Try adding this to the end of sub "Combinations" code :-
This creates a new array every 10000 rows and places it in the sheet 8 columns apart all starting row(1).
Rich (BB code):
Rem out the line below (in Red), in original "pog" code (as shown) and add the new code below.
' Range("A1").Resize(UBound(vResults), 1) = vResults
    Dim col As Integer
    Dim nRay
    Dim n As Long
    col = 1
    ReDim nRay(1 To 10000, 1 To 1)
    For n = 1 To UBound(vResults)
        c = c + 1
        nRay(c, 1) = vResults(n, 1)
        If n Mod 10000 = 0 Then
            Cells(1, col).Resize(10000) = nRay
            col = col + 8
            c = 0
            ReDim nRay(1 To 10000, 1 To 1)
        End If
    Next n
End Sub
 
Last edited:
Upvote 0
Sorry !!, theres a bit missing of that new bit of code'
It only adds columns of 10 k . The bit below adds the rows left over !!
Add the line in red !!
Rich (BB code):
            ReDim nRay(1 To 10000, 1 To 1)
        End If
        If n = UBound(vResults) Then Cells(1, col).Resize(10000) = nRay
    Next n
End Sub
 
Upvote 0

Forum statistics

Threads
1,203,383
Messages
6,055,112
Members
444,763
Latest member
Jaapaap

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