Solved

VB Macro in Excel

Posted on 2013-01-17
5
231 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

895 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

11 Experts available now in Live!

Get 1:1 Help Now