How To Copy/Cut Row of Data Based on TRUE/FALSE Condition

Question

I want to copy all the rows that meet the condition of TRUE in the 'Product Price List' sheet and paste them into the 'Customer List' sheet.

Not all columns need to be copied, only columns A, B, C and D.

If more TRUE conditions are met at a later time the 'Customer List' sheet should be cleared and re-pasted, to ensure continuity of Product Numbers.

'Product Price List Screenshot'

'Customer List' Screenshot

Answer 1

Assuming:

• Your sheets are set up exactly as shown in your screenshots
• The values in Column H are true Boolean values (i.e. not text masquerading as Booleans)
• All existing data on Customer List will be cleared and replaced with the updated list of values associated with TRUE

---

Macro Steps:

• Loop through the rows on Price List
• When Column H of the current row in loop is TRUE then:
  • Add values from the Column A - Column D to a Union which is referred to as true_collection in code
  • A Union is just a collection of cells. In this use case, it's used to create a non-continuous range to be copied/pasted

A more effecient way to do this would be to just filter your data set (Column H = TRUE) and then copy/paste the resultant (visible) cells of the filter. This is more-or-less how you would do this manually.

---

Sub free_code_come_get_your_free_code_free_code()

Dim pl As Worksheet: Set pl = ThisWorkbook.Sheets("Price List")
Dim cl As Worksheet: Set cl = ThisWorkbook.Sheets("Customer List")

Dim lr As Long, i As Long
Dim true_collection As Range

lr = pl.Range("H" & pl.Rows.Count).End(xlUp).Row


For i = 5 To lr
    If pl.Range("H" & i) Then
        If Not true_collection Is Nothing Then
            Set true_collection = Union(true_collection, pl.Range("A" & i).Resize(1, 4))
        Else
            Set true_collection = pl.Range("A" & i).Resize(1, 4)
        End If
    End If
Next i
            

If Not true_collection Is Nothing Then
    lr = cl.Range("A" & cl.Rows.Count).End(xlUp).Offset(1).Row
    cl.Range("A5:D" & lr).Clear
    
    true_collection.Copy
    cl.Range("A5").PasteSpecial xlPasteValues
End If

End Sub