Improve company productivity with a Business Account.Sign Up

x
?
Solved

VB Macro in Excel

Posted on 2013-01-17
5
Medium Priority
?
259 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 2000 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

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Microsoft's Excel has many features that most people will never need nor take advantage of.  Conditional formatting is one feature that you may find a necessity once you start using it.
Debits & Credits have been the foundation of financial record keeping since 1494 - over 500 years. Excel is a brilliant tool for leveraging this ancient power - not least with Pivot Tables, sorting and filtering.  This article seeks by illustration …
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

595 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