Copy Row based on if the last 4 column Values are combined are greater than Zero.

[BrayBoy]

Hello everyone, I am not new to VBA coding but I simply don't do it enough to stay good at it. A little background I have a Spreadsheet with 1,435 lines first 5 Columns basic user information next 12 columns are the hours recorded for this person for the Month. EX: ( Jan-19 = 160) which would be 160 hours for the month. I would like to have the option to Chose how many months used for the condition. but the Default should be 4. Assuming the combined Value is greater than 0 copy the entire row different worksheet ("Steady-State"). Could anyone assist?

Name	Jan -2019	Feb-2019	Mar-2019	Apr-2019	May-2019	Jun-2019	Jul-2019	Aug-2019
John Doe	160	80	184	169	0	0	0	0
Jane Doe	185	176	171	184	184	160	170	144

Based on the Default request of the last 4 columns combined being greater than Zero. Only Jane Doe's entire Row would be copied to the Steady-State Sheet.



Thanks for the help

 

[mumps]

Try:

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long, lCol As Long, response As Long, rName As Range, desWS As Worksheet
    Set desWS = Sheets("Steady-State")
    lCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    response = InputBox("Enter the number of columns.")
    For Each rName In Range("A2", Range("A" & Rows.Count).End(xlUp))
        If WorksheetFunction.Sum(Cells(rName.Row, lCol - 3).Resize(, response)) > 0 Then
            rName.EntireRow.Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next rName
    Application.ScreenUpdating = True
End Sub

 

[rpaulson]

Sub do_It()

x = InputBox("no fo columns to check", , 4)


Dim rs As Worksheet
Set rs = Worksheets("Steady-State")
For r = 2 To Cells(Rows.Count, "A").End(xlUp).Row

lc = Cells(r, Columns.Count).End(xlToLeft).Column

tot = WorksheetFunction.Sum(Range(Cells(r, lc), Cells(r, lc - x + 1)))
If tot > 0 Then Rows(r).Copy rs.Rows(rs.Cells(rs.Rows.Count, "A").End(xlUp).Row + 1) 'copy row to new sheet

Next r

End Sub

 

[BrayBoy]

Try:

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long, lCol As Long, response As Long, rName As Range, desWS As Worksheet
    Set desWS = Sheets("Steady-State")
    lCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    response = InputBox("Enter the number of columns.")
    For Each rName In Range("A2", Range("A" & Rows.Count).End(xlUp))
        If WorksheetFunction.Sum(Cells(rName.Row, lCol - 3).Resize(, response)) > 0 Then
            rName.EntireRow.Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next rName
    Application.ScreenUpdating = True
End Sub

 

[BrayBoy]

Mumps thank you for the Quick Response and help this worked as expected

 

[BrayBoy]

Sub do_It()

x = InputBox("no fo columns to check", , 4)


Dim rs As Worksheet
Set rs = Worksheets("Steady-State")
For r = 2 To Cells(Rows.Count, "A").End(xlUp).Row

lc = Cells(r, Columns.Count).End(xlToLeft).Column

tot = WorksheetFunction.Sum(Range(Cells(r, lc), Cells(r, lc - x + 1)))
If tot > 0 Then Rows(r).Copy rs.Rows(rs.Cells(rs.Rows.Count, "A").End(xlUp).Row + 1) 'copy row to new sheet

Next r

End Sub

 

[BrayBoy]

Rpaulson, thank you for the Quick Response. I liked Both options you Mumps provided but Thought your input boxed allowed users who do not know VBA to change the number of columns.. thank you both again for help ..