VBA Stops Running When it Reaches a Blank Cell

Closed
Fenrir91_9 Posts 4 Registration date Tuesday February 26, 2019 Status Member Last seen October 10, 2019 - Oct 10, 2019 at 10:00 PM
TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen October 4, 2022 - Oct 15, 2019 at 12:14 PM
Hello Everyone,

I have an Excel spreadsheet that I am preparing for use. In the spreadsheet, i have a VBA macro set up to transfer out data from the main sheet into separate sheets based on whether the answers in column J is "yes" or "no".

The macro is working well, except it stops running if there is a blank cell in the column. For example, if i have data listed from rows 2 through 10, but if an answer was not submitted in J6, the macro will only transfer out rows 2-5 into new sheets.

How can i get the macro to continue past the blank cell if there is one? Below is the VBA i have now.


Sub CopyByCriteriaMet()
Dim FilterRng As Range
Dim TargetSh As Worksheet
Dim Criteria As Variant
Dim DestSh As Worksheet

Application.ScreenUpdating = False
Set TargetSh = Worksheets("Sheet1")
Set FilterRng = Range("J1", Range("J1").End(xlDown))

FilterRng.AdvancedFilter xlFilterCopy, copytorange:=TargetSh.Range("P1"), unique:=True
Criteria = TargetSh.Range("P2", TargetSh.Range("P1").End(xlDown))
Columns("P").ClearContents

For m = LBound(Criteria, 1) To UBound(Criteria, 1)
Set DestSh = Worksheets.Add(after:=Sheets(Sheets.Count))
DestSh.Name = Criteria(m, 1)
FilterRng.AutoFilter field:=1, Criteria1:=Criteria(m, 1)
FilterRng.SpecialCells(xlCellTypeVisible).EntireRow.Copy DestSh.Range("A1")
Next
FilterRng.AutoFilter
TargetSh.Activate
Application.ScreenUpdating = True
End Sub


Thank you in advance for any help and advise!! :)

1 reply

TrowaD Posts 2900 Registration date Sunday September 12, 2010 Status Moderator Last seen October 4, 2022 523
Updated on Oct 15, 2019 at 12:14 PM
Hi Fenrir,

That is because the way you determine your "last" row.

Instead of using:
Range("J1").End(xlDown)

Use:
Range("J" & rows.count).End(xlUp)


Best regards,
Trowa

0