Page 3 of 3 FirstFirst 123
Results 21 to 26 of 26

Thread: For Every 1500 Rows Copy To New Sheet & Save

  1. #21
    Board Regular BlakeSkate's Avatar
    Join Date
    Jan 2015
    Location
    Pernsylvoonia
    Posts
    461
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)

    Default Re: For Every 1500 Rows Copy To New Sheet & Save

    Quote Originally Posted by JoeMo View Post
    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.
    perhaps my other codes are interfering then?
    the first time i ran it i had 5 sheets, but that included the sheets im trying to skip. after realizing this and letting the sheet go unresponsive i few times i managed to pause the macro
    the second time i ran it i did not pause the macro and it made my computer commit seppuku

    i have these two sheet/workbook codes

    in sheet1 ("Program Start")
    Code:
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$A$2" Then
       pStart.Show
       Sheets("Program Start").Select
    End If
    
    If Target.Address = "$A$3" Then
       Application.Run "PERSONAL.XLSB!dictionaryeBay"
       Sheets("Program Start").Select
    End If
    
    If Target.Address = "$A$4" Then
       exports.Show
       Sheets("Program Start").Select
    End If
    End Sub
    in "ThisWorkBook" i have
    Code:
    Sub Workbook_Open()
    
    'Update Finish Color Dictionary
    Application.Run "PERSONAL.XLSB!dictionarySHORT"
    Application.Run "Personal.xlsb!dictionaryFINISH"
    
    'Update Image Dictionary
    Application.Run "PERSONAL.XLSB!dictionaryIMG"
    
    'Update Quantity Dictionary
    Application.Run "PERSONAL.XLSB!dictionaryQTY"
    
    End Sub
    i did not attempt skipping the first sheet called "Program Start"
    i just ran your code as is.
    -------------------------------------------------------------------------------
    I may not give the best VBA codes, but they sure are VBA codes.
    Help me help you by posting a snapshot of your data & your expected result
    Please use [ code][ /code] tags when posting VBA as well as proper indentation

  2. #22
    MrExcel MVP
    Join Date
    May 2009
    Posts
    16,454
    Post Thanks / Like
    Mentioned
    36 Post(s)
    Tagged
    8 Thread(s)

    Default Re: For Every 1500 Rows Copy To New Sheet & Save

    Quote Originally Posted by BlakeSkate View Post
    perhaps my other codes are interfering then?
    the first time i ran it i had 5 sheets, but that included the sheets im trying to skip. after realizing this and letting the sheet go unresponsive i few times i managed to pause the macro
    the second time i ran it i did not pause the macro and it made my computer commit seppuku

    i have these two sheet/workbook codes

    in sheet1 ("Program Start")
    Code:
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$A$2" Then
       pStart.Show
       Sheets("Program Start").Select
    End If
    
    If Target.Address = "$A$3" Then
       Application.Run "PERSONAL.XLSB!dictionaryeBay"
       Sheets("Program Start").Select
    End If
    
    If Target.Address = "$A$4" Then
       exports.Show
       Sheets("Program Start").Select
    End If
    End Sub
    in "ThisWorkBook" i have
    Code:
    Sub Workbook_Open()
    
    'Update Finish Color Dictionary
    Application.Run "PERSONAL.XLSB!dictionarySHORT"
    Application.Run "Personal.xlsb!dictionaryFINISH"
    
    'Update Image Dictionary
    Application.Run "PERSONAL.XLSB!dictionaryIMG"
    
    'Update Quantity Dictionary
    Application.Run "PERSONAL.XLSB!dictionaryQTY"
    
    End Sub
    i did not attempt skipping the first sheet called "Program Start"
    i just ran your code as is.
    I found an error in the code I posted in post #18 that might possibly be the culprit with your more extensive data. Here's a revision you can try.
    Code:
    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  'ary & i is the ith element in MyArrays
    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, UBound(V, 2))) = V
        NxRw = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Erase V
    Next i
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    End Sub
    Joe

    When I was a young man I knew everything. Now that I'm older, I realize I know very little, and what I do know, I tend to forget!

  3. #23
    Board Regular BlakeSkate's Avatar
    Join Date
    Jan 2015
    Location
    Pernsylvoonia
    Posts
    461
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)

    Default Re: For Every 1500 Rows Copy To New Sheet & Save

    Quote Originally Posted by JoeMo View Post
    I found an error in the code I posted in post #18 that might possibly be the culprit with your more extensive data. Here's a revision you can try.
    now thats spot on and took all of 3 seconds
    the only thing i'm missing is the ability to select which sheets to target for this
    i usually grab my sheets like

    Code:
    Worksheets("Program Start").Index + 1 To Worksheets("Description Helper").Index - 1
    which is where i want the sheets condensed because they will always be between these two sheets
    also +1 for the error handling if condensedsheets already existed

    so i'm thinking
    Code:
    Dim MyArrays As Variant
    Dim i As Long
    Dim x As Long
    Dim numSHEETS As Long
    Dim NxRw As Long
    Dim V As Variant
    numSHEETS = Worksheets.Count '????
    ReDim MyArrays(1 To numSHEETS)
    
    x = 1
    
    For i = Worksheets("Program Start").Index + 1 To Worksheets("Description Helper").Index - 1
        
        MyArrays(x) = Sheets(i).Range("A1").CurrentRegion.Value2  'ary & i is the ith element in MyArrays
                 x = x + 1
    Next i


    but how do i dim the proper numbers of worksheets to create these arrays? or is it fine if the number of arrays is larger than what we are assigning values to?
    -------------------------------------------------------------------------------
    I may not give the best VBA codes, but they sure are VBA codes.
    Help me help you by posting a snapshot of your data & your expected result
    Please use [ code][ /code] tags when posting VBA as well as proper indentation

  4. #24
    MrExcel MVP
    Join Date
    May 2009
    Posts
    16,454
    Post Thanks / Like
    Mentioned
    36 Post(s)
    Tagged
    8 Thread(s)

    Default Re: For Every 1500 Rows Copy To New Sheet & Save

    Assuming you have the sheets you want to place in an array between the "bookend" sheets "program Start" and "Description Helper", and depending on whether "CondensedSheets" exists outside the bookends, this will put the correct sheets, regardless of their number into the arrays within MyArray. "CondensedSheets", if already in place prior to running the macro, will be deleted and a fresh CondensedSheets will be created by the macro. See the comment in red on the code below, in case there are other sheets that you don't want in the array.
    Code:
    Sub CondenseSheetsData()
    Dim MyArrays As Variant
    Dim i As Long
    Dim x As Long
    Dim numSHEETS As Long
    Dim NxRw As Long
    Dim V As Variant
    If SheetExists("CondensedSheets") Then
        numSHEETS = Sheets.Count - 3   '-3 is for shts that don't go into array:CondensedSheets and the 2 Bookends
    Else
        numSHEETS = Sheets.Count - 2
    End If
    ReDim MyArrays(1 To numSHEETS)
    x = 1
    For i = Worksheets("Program Start").Index + 1 To Worksheets("Description Helper").Index - 1
        MyArrays(x) = Sheets(i).Range("A1").CurrentRegion.Value2
        x = x + 1
    Next i
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("CondensedSheets").Delete
    On Error GoTo 0
    Worksheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "CondensedSheets"
    NxRw = 1
    For i = 1 To UBound(MyArrays)
        V = MyArrays(i)
        Range(Cells(NxRw, 1), Cells(NxRw + UBound(V, 1) - 1, UBound(V, 2))) = V
        NxRw = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Erase V
    Next i
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    End Sub
    Function SheetExists(shName As String) As Boolean
    SheetExists = False
    For Each sh In ActiveWorkbook.Sheets
        If sh.Name = shName Then
            SheetExists = True
            Exit For
        End If
     Next sh
    End Function
    Be sure to copy ALL the code, including the Function at the bottom, from your browser, and paste it to the VB window.
    Joe

    When I was a young man I knew everything. Now that I'm older, I realize I know very little, and what I do know, I tend to forget!

  5. #25
    Board Regular BlakeSkate's Avatar
    Join Date
    Jan 2015
    Location
    Pernsylvoonia
    Posts
    461
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)

    Default Re: For Every 1500 Rows Copy To New Sheet & Save

    Quote Originally Posted by JoeMo View Post
    Assuming you have the sheets you want to place in an array between the "bookend" sheets "program Start" and "Description Helper", and depending on whether "CondensedSheets" exists outside the bookends, this will put the correct sheets,
    this is EXACTLY what i was looking for
    thank you so much
    -------------------------------------------------------------------------------
    I may not give the best VBA codes, but they sure are VBA codes.
    Help me help you by posting a snapshot of your data & your expected result
    Please use [ code][ /code] tags when posting VBA as well as proper indentation

  6. #26
    MrExcel MVP
    Join Date
    May 2009
    Posts
    16,454
    Post Thanks / Like
    Mentioned
    36 Post(s)
    Tagged
    8 Thread(s)

    Default Re: For Every 1500 Rows Copy To New Sheet & Save

    Quote Originally Posted by BlakeSkate View Post
    this is EXACTLY what i was looking for
    thank you so much
    You are welcome - thanks for the reply.
    Joe

    When I was a young man I knew everything. Now that I'm older, I realize I know very little, and what I do know, I tend to forget!

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •