0

I am splitting each row into its own workbook (based on name). If the workbook already exists, it adds it to the next available line. I know the code isn't the prettiest, but it works! I ran it a few times without error. After testing, I tried on a data set of over 1000 rows. For some reason, it errors out about 3% of the time. I can't seem to figure out what causes it. Every Cell in (i, 1) is filled in and has no special characters.


For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row
    n = Cells(i, 1).Value
    strFileName1 = strPath1 & n & ".xlsx"
    Rows(i).EntireRow.Copy

    If Dir(strFileName1) = "" Then
        Workbooks.Add
        ActiveWorkbook.Sheets("Sheet1").Range("A1").Select
        ActiveWorkbook.Sheets("Sheet1").Paste
        ActiveWorkbook.SaveAs Filename:=strFileName1
        ActiveWorkbook.Close SaveChanges:=False
    Else
        Workbooks.Open (strFileName1)
        Range("A" & Rows.Count).End(xlUp).Offset(1).Select
        ActiveWorkbook.Sheets("Sheet1").Paste
        ActiveWorkbook.SaveAs Filename:=strFileName1
        ActiveWorkbook.Close SaveChanges:=False
    End If

Next

RobertBaron
  • 2,817
  • 1
  • 12
  • 19
  • 2
    What error do you get, at what line? Also, make sure you qualify what worksheet you are getting the `Cells()` information from. Otherwise it'll use whatever the `ActiveSheet` is at the time that line runs. – BruceWayne Jul 12 '19 at 21:00
  • If you run it multiple times does it error on the same lines? If you can figure that out you can place a break point at when that lines shows up and stepping through check the watch values and see where the error is. – nbayly Jul 12 '19 at 21:35
  • Its random and does not error at the same line. It must be what the other user stated below, where I need to be more explicit about my active book. At this point, that would make the most sense. – Jared Swayne Jul 13 '19 at 02:08

1 Answers1

0

Might be a little improved if you are more explicit about your ranges and sheets:

Dim wb As Workbook, rngDest
Dim shtSrc As Worksheet, i As Long

Set shtSrc = ActiveSheet

For i = 4 To shtSrc.Cells(shtSrc.Rows.Count, 1).End(xlUp).Row

    n = shtSrc.Cells(i, 1).Value
    strFileName1 = strPath1 & n & ".xlsx"

    If Dir(strFileName1) = "" Then
        Set wb = Workbooks.Add()
        wb.SaveAs Filename:=strFileName1
        Set rngDest = wb.Sheets("Sheet1").Range("A1")
    Else
        Set wb = Workbooks.Open(strFileName1)
        Set rngDest = wb.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End If

    shtSrc.Rows(i).EntireRow.Copy rngDest
    wb.Close savechanges:=True

Next

See also: How to avoid using Select in Excel VBA

Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • I would have to agree with you. I wouldn't say I'm new to VBA, but I'm definitely no expert. I was proud of my code, but knew it was nowhere near what it should be to define it as good code. Thanks for your input! I'll try it out on Monday! Have a good weekend. – Jared Swayne Jul 13 '19 at 02:10
  • Seems to be working faster and flawlessly so far. I'm through around 5000 lines so far and its running like a champ. Thanks for your help, I'll keep these alterations in mind next time I create something similar. – Jared Swayne Jul 13 '19 at 19:58