Hello, I am trying to run a simple loop and am having trouble. I would like for this loop to run through the data in an excel spreadhseet and analize column "p". Upon analisys, the macro will create a new worksheet each time it encounters a new digit in coulmn "p". It will then take all rows (and content within) conatining that identifier and pull it to the new worksheet. The current code is running a loop that will stop each time the first new worksheet is created. The code is as follows. I see the errors in rows 9 - 11 but am unable to figure how to fix it. any and all help is appreciated.

Thank You ahead of time,

Colin

Sub copy_rows_to_sheets()
  Dim firstrow, lastrow, r, torow As Integer
  Dim fromsheet, tosheet As Worksheet
  firstrow = 1
  Set fromsheet = ActiveSheet
  lastrow = ActiveSheet.Cells(Rows.Count, "P").End(xlUp).Row
  For r = firstrow To lastrow
    If fromsheet.Cells(r, "P") <> "" Then  'skip rows where column P is empty
      On Error GoTo make_new_sheet
      Set tosheet = Worksheets("" & fromsheet.Cells(r, "P"))
      On Error GoTo 0
      GoTo copy_row
make_new_sheet:
      Set tosheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
      tosheet.Name = fromsheet.Cells(r, "P")
copy_row:
      torow = tosheet.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
      fromsheet.Cells(r, 1).EntireRow.Copy
      tosheet.Cells(torow, 1).PasteSpecial Paste:=xlPasteValues
    End If
  Next r
  Application.CutCopyMode = False
  fromsheet.Activate
End Sub

Recommended Answers

All 2 Replies

If you still need it you can try this...

     Sub copy_rows_to_sheets()
        ' You must Dimensionalize each variable individually.
        Dim firstrow As Byte, lastrow As Long, r As Long, torow As Long
        Dim fromsheet As Worksheet, tosheet As Worksheet
        firstrow = 1
        Set fromsheet = ActiveSheet
        lastrow = ActiveSheet.Cells(Rows.Count, "P").End(xlUp).Row
        For r = firstrow To lastrow
            If fromsheet.Cells(r, "P") <> "" Then 'skip rows where column P is empty
                ' Check if the sheet exists with an external function.
                If Sheet_Exists(fromsheet.Cells(r, "P").Text) Then
                    ' If the sheet exsits set it as your tosheet.
                    Set tosheet = Worksheets(fromsheet.Cells(r, "P").Text) ' < Specify the cell Text as the new sheet name.
                Else ' If the sheet doesn't exists, add it.
                    Set tosheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                    tosheet.Name = fromsheet.Cells(r, "P")
                End If
                torow = tosheet.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
                fromsheet.Cells(r, 1).EntireRow.Copy
                tosheet.Cells(torow, 1).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
            End If
            fromsheet.Select
        Next r
    End Sub

    ' Move your On Error method to an external function to help clear the on error capture.
    Private Function Sheet_Exists(Sheet_Name As String) As Boolean
        Dim x As Worksheet
        On Error GoTo EOS
            Set x = Worksheets(Sheet_Name)
        On Error GoTo 0
        Sheet_Exists = True
    EOS:
        Set x = Nothing
    End Function
commented: Nicely broken down. +13

Remember:
In MS Excel 97 to MS Excel 2003 .........[Files Saved As: *.xls]
.... Maximum: Rows = 65,365 | Columns = 256 (Column: 'IV')
In MS Excel 2007 to 2010 ................[Files Saved As: *.xlsx]
.... Maximum: Rows = 1,048,576 | Columns = 16,384 (Column: 'XFD')

(Reference: 'http://office-watch.com/t/n.aspx?a=1408')

So make sure you don't miss Dim your variable types, and wind up capping yourself. Just use the largest type you know you will need. ie. If your NOT going to use all of the rows in Excel, integer should be fine upto 32,768 rows. Otherwise you could run into a buffer overflow.)
.... Byte .... is ... (0 to 255) ...................... [Size: 1 byte] Less memory used.
.... Integer . is ... (-32,768 to 32,768) ............. [Size: 2 bytes]More memory used.
.... Long .... is ... (-2,147,483,648 to 2,147,483,648) [Size: 4 bytes]Even More memory used.

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.