VBA Stops Running When it Reaches a Blank Cell

Posts
4
Registration date
Tuesday February 26, 2019
Status
Member
Last seen
October 10, 2019
- - Latest reply: TrowaD
Posts
2562
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 14, 2019
- 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!! :)

See more 

1 reply

Posts
2562
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 14, 2019
370
0
Thank you
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

Respond to TrowaD