VBA Stops Running When it Reaches a Blank Cell

Report
Posts
4
Registration date
Tuesday February 26, 2019
Status
Member
Last seen
October 10, 2019
-
TrowaD
Posts
2581
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 9, 2020
-
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

Posts
2581
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 9, 2020
386
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