Solved

VB Macro in Excel

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

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Not long ago I saw a question in the VB Script forum that I thought would not take much time. You can read that question (Question ID  (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28455246.html)28455246) Here (http…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

830 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