How can i limit my vba to only copy max of 30 rows?

[tonywatsonhelp]

Hi Everyone,

I have a macro that copys and paste data into another sheet,
It works great but I only have 30 rows avaliable to paste into,
is there a way i can say "If rows to copy are greater than 30 only copy first 30?
i've shown my current formula

my code:

Sub filter1()
Subms.AutoFilterMode = False
LR1 = Subms.Cells(Rows.Count, "A").End(xlUp).Row

Subms.Range("$H$10:$BP$" & LR1).AutoFilter Field:=1, Criteria1:="Signed"
Subms.Range("$H$10:$BP$" & LR1).AutoFilter Field:=61, Criteria1:="Pacific"
Subms.Range("$H$10:$BP$" & LR1).AutoFilter Field:=42, Criteria1:=">0"

'''Count if the filter shows any results
lr2 = Subms.Cells(Rows.Count, "A").End(xlUp).Row
If lr2 < 11 Then
lr2 = 11
End If

xCount = 0
For Each xCell In Subms.Range("A11:A" & lr2)
If (Not xCell.EntireRow.Hidden) Then
xCount = xCount + 1
End If
Next
If xCount > 0 Then

Subms.Range("M11:M" & lr2).SpecialCells(xlCellTypeVisible).Copy
PDFR.Range("Ac864").PasteSpecial xlPasteValues

Subms.Range("AH11:AH" & lr2).SpecialCells(xlCellTypeVisible).Copy
PDFR.Range("AE864").PasteSpecial xlPasteValues

Subms.Range("AW11:AW" & lr2).SpecialCells(xlCellTypeVisible).Copy
PDFR.Range("AG864").PasteSpecial xlPasteValues
End If
End Sub

 

[rollis13]

If I correctly understood your request this is how I would change the macro:

[...]
Next
If xCount > 0 Then
    If lr2 > 30 Then lr2 = 30                 '<- added
    Subms.Range("M11:M" & lr2).SpecialCells(xlCellTypeVisible).Copy
    PDFR.Range("Ac864").PasteSpecial xlPasteValues
[...]

 

[tonywatsonhelp]

Hi Rollis,
thank you for you help, but,
Correct me if I'm wrong on this but the way i read your suggestion I stop on row 30?
Effectively what you have given me is:
Subms.Range("M11:M30").SpecialCells(xlCellTypeVisible).Copy (as Lr2 = 30?)
what need is a maximum of 30 rows.

So I start at row M11 and go down the Filtered Rows counting only the visible rows until i get to the 30th row and Lr2 = that row.

If I was writing this in English it would read like this:
Start at cell M11,
Count "Visible Rows with data" only, If count is Greater than 30, then find what row is the 30th and Lr2 = that row, if not, Lr2 = last row?

which sounds easy but i cant translate it into VBA

Please help.

Thanks
Tony

 

[rollis13]

Yes, sorry, there was a wrong counting . With my suggestion I wasn't counting 'Visible' rows. Here is your new macro:

Sub filter1()
    'clear previous filters
    Subms.AutoFilterMode = False
    'apply filters
    LR1 = Subms.Cells(Rows.Count, "A").End(xlUp).Row
    Subms.Range("$H$10:$BP$" & LR1).AutoFilter Field:=1, Criteria1:="Signed"
    Subms.Range("$H$10:$BP$" & LR1).AutoFilter Field:=61, Criteria1:="Pacific"
    Subms.Range("$H$10:$BP$" & LR1).AutoFilter Field:=42, Criteria1:=">0"
    'count if filter shows any results
    LR2 = Subms.Range("A11:A" & LR1).SpecialCells(xlCellTypeVisible).Count
    If LR2 > 0 Then
        'limit to max 30
        xCount = 0
        For Each xCell In Subms.Range("A11:A" & LR1)
            If (Not xCell.EntireRow.Hidden) Then xCount = xCount + 1
            If xCount = 30 Then LR2 = xCell.Row: Exit For
        Next
        'apply copy/paste
        Subms.Range("M11:M" & LR2).SpecialCells(xlCellTypeVisible).Copy
        PDFR.Range("AC864").PasteSpecial xlPasteValues
        Subms.Range("AH11:AH" & LR2).SpecialCells(xlCellTypeVisible).Copy
        PDFR.Range("AE864").PasteSpecial xlPasteValues
        Subms.Range("AW11:AW" & LR2).SpecialCells(xlCellTypeVisible).Copy
        PDFR.Range("AG864").PasteSpecial xlPasteValues
    End If
    'cleanout
    Application.CutCopyMode = False
    Subms.AutoFilterMode = False
End Sub

 

[tonywatsonhelp]

Rolllis, thank you,
this works grreat.
Tony

 

[rollis13]

Glad having been of some help.