Solved

VB Macro in Excel

Posted on 2013-01-17
5
230 Views
Last Modified: 2013-01-19
I have a very large sheet in excel, approx 260,000 rows. Because I will often need to seperate this file out by 50,000 rows, I am wanting a macro to make sure I dont accidentally omit rows when I am doing this manually.

So:

I need a macro that will keep the first row (column headers) and create a new sheet for rows 1:50,000, then another sheet for rows 50,001 to 100,000 (but making sure I still have row 1 for the column header), 100,000 to 149,999, ...etc.

It can seperate out to new sheets in the original workbook if that makes things easier.
0
Comment
Question by:wrt1mea
  • 3
  • 2
5 Comments
 
LVL 26

Accepted Solution

by:
redmondb earned 500 total points
ID: 38790080
Hi, wrt1mea.

Please see attached. The code is...
Option Explicit

Sub Split_Sheet1()
Dim xLast_Row As Long
Dim xSheet    As Worksheet
Dim i         As Long
Dim xLo       As Long
Dim xHi       As Long
Dim xDone As Boolean

ThisWorkbook.Sheets("Sheet1").Activate
Set xSheet = ActiveSheet
If xSheet.UsedRange.Rows.Count < 0 Then Debug.Print "!?"

xLast_Row = [A1].SpecialCells(xlLastCell).Row

If xLast_Row < 50000 Then
    MsgBox ("Sheet1 has less than 50,000 rows - run cancelled.")
    Exit Sub
End If

For i = 1 To (xLast_Row \ 50000) + 2
        
    xLo = (i - 1) * 49999 + 2
    If xLo = 2 Then xLo = 1
    
    xHi = i * 49999 + 1
    If xHi >= xLast_Row Then
        xHi = xLast_Row
        xDone = True
    End If
    
    Debug.Print xLo & " - " & xHi & " - " & xHi - xLo
    
    Sheets.Add
    If xLo <> 1 Then xSheet.Range("1:1").EntireRow.Copy Destination:=ActiveSheet.Range("A1")
    xSheet.Range(xLo & ":" & xHi).EntireRow.Copy Destination:=ActiveSheet.Range(IIf(xLo = 1, "A1", "A2"))
    
    If xDone Then Exit For
    
Next

End Sub

Open in new window

Regards,
Brian.Split-File.xlsb
0
 
LVL 1

Author Closing Comment

by:wrt1mea
ID: 38793720
WORKS GREAT! THANKS!
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38793963
Thanks, wrt1mea.

BTW, if you find this slow, it could possibly be speeded up by turning off screen updating and calculations. Let me know if you want to do this.

Thanks,
Regards.
0
 
LVL 1

Author Comment

by:wrt1mea
ID: 38793992
sure...sounds good to me.
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38796487
wrt1mea,

The revised code is...
Option Explicit

Sub Split_Sheet1()
Dim i            As Long
Dim xLo          As Long
Dim xHi          As Long
Dim xLast_Row    As Long
Dim xCalculation As Long
Dim xDone        As Boolean
Dim xSheet       As Worksheet

ThisWorkbook.Sheets("Sheet1").Activate
Set xSheet = ActiveSheet

If xSheet.UsedRange.Rows.Count < 0 Then Debug.Print "!?"    ' Force Excel to recalculate the last cell.
xLast_Row = [A1].SpecialCells(xlLastCell).Row

If xLast_Row < 50000 Then
    MsgBox ("Sheet1 has less than 50,000 rows - run cancelled.")
    Exit Sub
End If

xCalculation = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
    
    For i = 1 To (xLast_Row \ 50000) + 2
            
        xLo = (i - 1) * 49999 + 2
        If xLo = 2 Then xLo = 1
        
        xHi = i * 49999 + 1
        If xHi >= xLast_Row Then
            xHi = xLast_Row
            xDone = True
        End If
        
        Debug.Print xLo & " - " & xHi & " - " & xHi - xLo
        
        Sheets.Add
        If xLo <> 1 Then xSheet.Range("1:1").EntireRow.Copy Destination:=ActiveSheet.Range("A1")
        xSheet.Range(xLo & ":" & xHi).EntireRow.Copy Destination:=ActiveSheet.Range(IIf(xLo = 1, "A1", "A2"))
        
        If xDone Then Exit For
        
    Next
    
Application.Calculation = xCalculation
Application.ScreenUpdating = True

End Sub

Open in new window

Regards,
Brian.
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now