Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

VB Macro in Excel

Posted on 2013-01-17
5
Medium Priority
?
250 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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

On Demand Webinar: Networking for the Cloud Era

Ready to improve network connectivity? Watch this webinar to learn how SD-WANs and a one-click instant connect tool can boost provisions, deployment, and management of your cloud connection.

Question has a verified solution.

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

This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
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 a scrolling table in Microsoft Excel using the INDEX function.

721 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