Copy Cells Which Contain Data From Tick Boxes and Drop Downs

Question

I have a spreadsheet with working VBA to copy certain cells to another worksheet when a condition is met.

Currently I have tick boxes (in column C) which are linked to a cell to the right of it (column D) so when the cell reads TRUE the code copies the name and the cost associated with it. I also have a reset button which empties any checked tick boxes and therefore changes all the cells in column D (please see attached image) to FALSE.

Spreadsheet

The problem is this; I have added some additional names which requires the user to state the number associated with it so the tick box in these instances have been replaced with a drop down with options from 0 to 6, however the reset button still causes the cell next to the drop downs to read as FALSE.

My question therefore is, how do I amend the code (please see below) to copy the name and the cost where the tick boxes state TRUE (in column D) and the drop downs state a number other than 0 (in column C)?

[Private Sub CommandButton1_Click()
Dim lastrow As Long, erow As Long
'to check the last filled row on sheet named one
lastrow = Worksheets("one").Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lastrow
If Worksheets("one").Cells(i, 4).Value = "TRUE" Then
    Worksheets("one").Cells(i, 2).Copy
    erow = Worksheets("two").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("one").Paste Destination:=Worksheets("two").Cells(erow + 1, 1)
    Worksheets("one").Cells(i, 5).Copy
    Worksheets("one").Paste Destination:=Worksheets("two").Cells(erow + 1, 2)
End If
Next i
End Sub][1]

John de Haan John de Haan · Accepted Answer · 2018-05-16T18:44:23

My first answer on Stack Overflow. I'm sure there's a more efficient way to do it, but this seems to work at least.

Private Sub CommandButton1_Click()
    Dim lastrow As Long, erow As Long
    'to check the last filled row on sheet named one
    lastrow = Worksheets("one").Cells(Rows.Count, 2).End(xlUp).Row
    For i = 2 To lastrow
    If Worksheets("one").Cells(i, 4).Value = True Then
        Worksheets("one").Cells(i, 2).Copy
        erow = Worksheets("two").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("one").Paste Destination:=Worksheets("two").Cells(erow + 1, 1)
        Worksheets("one").Cells(i, 5).Copy
        Worksheets("one").Paste Destination:=Worksheets("two").Cells(erow + 1, 2)
    ElseIf Worksheets("one").Cells(i, 3).Value >= 1 And Worksheets("one").Cells(i, 3).Value <= 6 Then
        Worksheets("one").Cells(i, 2).Copy
        erow = Worksheets("two").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("one").Paste Destination:=Worksheets("two").Cells(erow + 1, 1)
        Worksheets("one").Cells(i, 5).Copy
        Worksheets("one").Paste Destination:=Worksheets("two").Cells(erow + 1, 2)
    End If
    Next i
End Sub

Copy Cells Which Contain Data From Tick Boxes and Drop Downs

1 Answers