For Every 1500 Rows Copy To New Sheet & Save

[DataBlake]

I'm struggling with the logic behind this statement
I assign an entire sheet to an array
then i want
for every 1500 rows
write those values to new sheets
include header/insert header
save as csv (comma delimited) and close sheet
next 1500 rows

This is to happen until there are no rows left and the last sheet will be under 1500

My attempt:

Dim ary1 as Variant
Dim ws as WorkSheet
Dim i as Long
Dim x as Long

'establish sheet, array, and last column of activesheet
Set ws = ActiveSheet
  ary1 = ws.Range("A1").CurrentRegion.Value2
    lastCol = openWB.Sheets(1).Range("A1").SpecialCells(xlCellTypeLastCell).Column

'loop through array by rows
for i = 1500 to UBound(ary1)

'for every 1500 rows of the array what do?
Sheets.Add (After:= ws)
'ActiveSheet.Range("A1").Resize(???(ary1), lastCol).Value = ary1



Dim fold As String: fold = "C:\Users\user\Desktop\"
Dim fName  As String: fName = "newSHEET"

  With ActiveWorkbook
    .SaveAs fold & fName & Format(Date, "MM-DD-YYYY") & ".csv", FileFormat:=xlCSV
    .Close False
  End With
  
ActiveSheet.Delete

My brain is not comprehending how to loop through the array as 1500
any help would be appreciated

 

[DataBlake]

You could also consider limiting the array to 1500 rows per loop, something like this:

    ary = ws.Range(ws.Cells(Ct * NumRws + 1, "A"), ws.Cells(NumRws * (Ct + 1), lastCol)).Value2

AH!
its perfect, so fast.
any idea how i would go about doing the inverse of this?
One that says for each sheet add the current region as part of the array?

Sub arrangeADD()

   Dim i As Long, j As Long
   Dim was As Worksheet
   Dim Ary As Variant
   Dim lastRow As Long
   Dim destRow As Long


    ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(1)
    Set ws = ActiveSheet
    
   For i = Worksheets("Program Start").Index + 1 To Worksheets("Description Helper").Index - 1
            Ary = Sheets(i).Range("A1").CurrentRegion.Value2
   Next i
            ws.Range("A1").Resize(UBound(Ary), 19).Value = Ary
End Sub

so i've added a sheet and i want to condense multiple sheets into one array
so instead of limiting the array to 1500 from a sheet we add multiple sheets of a workbook to an array
so lets say we run your code and then we want to inverse it by adding the sheets between "Program Start" and "Description Helper" to an array
but my code here only copies the last sheet in the loop because i don't know how to add to an array i guess? if that makes sense

 

[DataBlake]

Why? you are writing a continuous range to the sheets the same number of times.

i don't know the technicalities but i can assure you that JoeMo's code is faster than Dante's
Its the same for all of my code now. I've overhauled my entire system of macros to run with arrays and dictionaries and its cutting multiple hours of processing code per day.
i believe its the difference in writing vs copy pasting. one is sequential the other is not?
don't know for sure but that is my guestimate

 

[MARK858]

You'll probably find that it is the use of copy in DanteAmor's code which is using the clipboard that is making the big difference in this case, if it was a .Value = .Value then I would suspect the speed would be closer.

The advantage of using an array is when it is cutting down the number of interactions with a sheet for instance if you looped through 10 rows, copying and pasting alternate rows each time then you would interact with the sheet 5 times, if you fed the values into an array then you would interact with the sheet only once.

I have no problem using arrays for this, I was just wondering why it was specifically using the array that would make the code faster.

 

[JoeMo]

AH!
its perfect, so fast.
any idea how i would go about doing the inverse of this?
One that says for each sheet add the current region as part of the array?

Sub arrangeADD()

   Dim i As Long, j As Long
   Dim was As Worksheet
   Dim Ary As Variant
   Dim lastRow As Long
   Dim destRow As Long


    ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(1)
    Set ws = ActiveSheet
    
   For i = Worksheets("Program Start").Index + 1 To Worksheets("Description Helper").Index - 1
            Ary = Sheets(i).Range("A1").CurrentRegion.Value2
   Next i
            ws.Range("A1").Resize(UBound(Ary), 19).Value = Ary
End Sub

so i've added a sheet and i want to condense multiple sheets into one array
so instead of limiting the array to 1500 from a sheet we add multiple sheets of a workbook to an array
so lets say we run your code and then we want to inverse it by adding the sheets between "Program Start" and "Description Helper" to an array
but my code here only copies the last sheet in the loop because i don't know how to add to an array i guess? if that makes sense

I haven't got the time right now to help with this, but I would consider creating an array of arrays, let's call it AryOfSheets, each element of which holds the data from one sheet and uses the sheet index to identify it. So, first sheet data goes into ary1, next sheet to ary2 and so on. Then you process AryOfSheets to do whatever you want with any or all of the sheets it holds.

 

[DataBlake]

So, first sheet data goes into ary1, next sheet to ary2 and so on.

defining and calling these sheet arrays seems to be difficult considering they need to by dynamic

   Dim i As Long, j As Long
   Dim ws As Worksheet
   Dim aryEATER As Variant
   numSHEETS = (Worksheets("Description Helper").Index - 2)
   ReDim Ary(numSHEETS) As Variant

    ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(1)
    Set ws = ActiveSheet
    
   For i = 1 To numSHEETS
    Sheets(i).Range("A1").CurrentRegion.Value2 = Ary & i
   Next i

my head is spinning

 

[JoeMo]

defining and calling these sheet arrays seems to be difficult considering they need to by dynamic

   Dim i As Long, j As Long
   Dim ws As Worksheet
   Dim aryEATER As Variant
   numSHEETS = (Worksheets("Description Helper").Index - 2)
   ReDim Ary(numSHEETS) As Variant

    ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(1)
    Set ws = ActiveSheet
    
   For i = 1 To numSHEETS
    Sheets(i).Range("A1").CurrentRegion.Value2 = Ary & i
   Next i

my head is spinning

Maybe:

Dim MyArrays As Variant
Dim i As Long
Dim numSHEETS As Long
numSHEETS = (Worksheets("Description Helper").Index - 2)
ReDim MyArrays(1 To numSHEETS)
For i = 1 To UBound(MyArrays)
    MyArrays(i) = Sheets(i).Range("A1").CurrentRegion.Value2  'ary & i is the ith element in MyArrays
Next i

 

[DataBlake]

MyArrays(i) = Sheets(i).Range("A1").CurrentRegion.Value2 'ary & i is the ith element in MyArrays

i actually tried that method of writing to the array but i didn't have "1 to numsheets" so it was just reading it as MyArrays(4)
i see the error of my ways ray:

now to just understand how to write the array of arrays to a sheet

Sub blakeskate()


Dim MyArrays As Variant
Dim i As Long, x As Long
Dim ws As Worksheet
Dim lastRow As Long
Dim numSHEETS As Long
numSHEETS = (Worksheets("Description Helper").Index - 1) ' doesn't unclude description helper
ReDim MyArrays(2 To numSHEETS) ' skips program start sheet



For i = LBound(MyArrays) To UBound(MyArrays)
    MyArrays(i) = Sheets(i).Range("A1").CurrentRegion.Value2
Next i

Worksheets.Add After:=ActiveSheet
Set ws = ActiveSheet

For x = LBound(MyArrays) To UBound(MyArrays)
        ws.Range("A1").Resize(UBound(MyArrays(x)), 19).Value = MyArray
Next x
    
End Sub

can i even use resize since the size of this array is technically 4 when running this on 4 sheets?
or does it need to be something like MyArrays(x) for the ubound of all 4 sheets?

 

[JoeMo]

i actually tried that method of writing to the array but i didn't have "1 to numsheets" so it was just reading it as MyArrays(4)
i see the error of my ways ray:

now to just understand how to write the array of arrays to a sheet

can i even use resize since the size of this array is technically 4 when running this on 4 sheets?
or does it need to be something like MyArrays(x) for the ubound of all 4 sheets?

Lightly tested, but see if this comes close to what you want.

Sub CondenseSheetsData()
Dim MyArrays As Variant
Dim i As Long
Dim numSHEETS As Long
Dim NxRw As Long
Dim V As Variant
numSHEETS = 5    '(Worksheets("Description Helper").Index - 1)
ReDim MyArrays(1 To numSHEETS)
For i = 1 To UBound(MyArrays)
    MyArrays(i) = Sheets(i).Range("A1").CurrentRegion.Value2  'MyArrays(i) is the equivalent of ary & i, i.e. a 2-D array of sheet(i) values
Next i
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Sheets("CondensedSheets").Delete
On Error GoTo 0
Worksheets.Add after:=Sheets(numSHEETS)
ActiveSheet.Name = "CondensedSheets"
NxRw = 1
For i = 1 To UBound(MyArrays)
    V = MyArrays(i)
    Range(Cells(NxRw, 1), Cells(NxRw + UBound(V, 1) - 1, NxRw + UBound(V, 2) - 1)) = V
    NxRw = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Erase V
Next i
Sheets("CondensedSheets").Cells.Replace "#N/A", ""
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[DataBlake]

Lightly tested, but see if this comes close to what you want.

this actually crashes my work pc
i was thinking this would be less stress than my current method of nested vlookups being copied down to the sum of all the lastrows of sheets and then pasting as values
apparently.....not
i may have to give up on the array of arrays idea and yeild to dynamics, and just create an array for each sheet.
but again i have no clue as to what the latter half of your code says/does


would it be possible to paste 1 array to a destination row?
like lets says i use an array to grab Sheet2 and write it to CondensedSheets
then i take Sheet3 and write it to CondensedSheets at the destination row ?
like

Sub BlakeSkate()
   Dim i As Long, j As Long
   Dim lastRow as Long
   Dim destRow as Long
   Dim Ary As Variant
   Dim sStart as Long
   Dim sEnd as Long
   
  'Loops through the sheets 
   For i = Worksheets("Program Start").Index + 1 To Worksheets("Master Image").Index - 1
      With Sheets(i)
         Ary = .Range("A1").CurrentRegion.Value2

      'writes the array back to a sheet using destination row
[B][COLOR=#ff0000][SIZE=4]      destrow = Sheets("CondensedSheets").Range("A" & Rows.Count).End(xlUp).Row + 1
      Sheets("CondensedSheets").Range("A" & destRow).Resize(UBound + destRow - 1(Ary), 19).Value = Ary[/SIZE][/COLOR][/B]
      End With
   Next i
End Sub

basically if i can write an array to the row after the last row of the sheet i should be good.

 

[JoeMo]

this actually crashes my work pc
i was thinking this would be less stress than my current method of nested vlookups being copied down to the sum of all the lastrows of sheets and then pasting as values
apparently.....not
i may have to give up on the array of arrays idea and yeild to dynamics, and just create an array for each sheet.
but again i have no clue as to what the latter half of your code says/does


would it be possible to paste 1 array to a destination row?
like lets says i use an array to grab Sheet2 and write it to CondensedSheets
then i take Sheet3 and write it to CondensedSheets at the destination row ?
like

Sub BlakeSkate()
   Dim i As Long, j As Long
   Dim lastRow as Long
   Dim destRow as Long
   Dim Ary As Variant
   Dim sStart as Long
   Dim sEnd as Long
   
  'Loops through the sheets 
   For i = Worksheets("Program Start").Index + 1 To Worksheets("Master Image").Index - 1
      With Sheets(i)
         Ary = .Range("A1").CurrentRegion.Value2

      'writes the array back to a sheet using destination row
[B][COLOR=#ff0000][SIZE=4]      destrow = Sheets("CondensedSheets").Range("A" & Rows.Count).End(xlUp).Row + 1
      Sheets("CondensedSheets").Range("A" & destRow).Resize(UBound + destRow - 1(Ary), 19).Value = Ary[/SIZE][/COLOR][/B]
      End With
   Next i
End Sub

basically if i can write an array to the row after the last row of the sheet i should be good.

I tested the code I posted on a workbook with 5 sheets and it ran fine for me albeit with far fewer populated rows on each sheet than you have on your sheets. I don't see any difference between the array of arrays and writing one array at a time to the condensed sheet, but you can certainly do it one-at-a-time by looping through the sheets.