IF two criteria are met then copy certain column to another sheet with VBA

Question

I'm new to VBA :', I wonder if I could use the If AND function within VBA. When columns C and D are filled with values, VBA will automatically copy columns A, B, and E and paste them to another sheet. Plus if it is possible i want to make it dynamic.

For example, I have this table in Sheet1:

Name	Phone#	Class	Graduated	Score
Ariana	749142	9	Yes	3.6
Brian	454364			3.7
Harry	143246	12	Yes	4
Mady	356647	10		2.9

Columns C and D need to have a value inside both cells, then VBA will copy columns A, B, and E to columns A, B, and C in Sheet2.

However, VBA will do nothing with the row if:

• only one column has value (e.g. row 5)

• both columns have no value (e.g. row 3)

I hope it make sense :)

Answer 1

• Right click on Sheet1 tab > View Code > paste code into sheet1 module

Microsoft documentation:

Application.Intersect method (Excel)

Range.CountLarge property (Excel)

Worksheet.Change event (Excel)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Me.Range("C:D")) Is Nothing Then
        With Target
            If .CountLarge = 1 Then
                Dim iR As Long: iR = .Row
                If Len(Me.Cells(iR, "C")) > 0 And Len(Me.Cells(iR, "D")) > 0 Then
                    Dim lastRow As Long, oSht As Worksheet
                    Set oSht = Sheets("Sheet2")
                    lastRow = oSht.Cells(oSht.Rows.Count, "A").End(xlUp).Row
                    If Len(oSht.Cells(lastRow, 1)) > 0 Then lastRow = lastRow + 1
                    oSht.Cells(lastRow, 1).Resize(1, 3).Value = _
                        Array(Me.Cells(iR, "A"), Me.Cells(iR, "B"), Me.Cells(iR, "E"))
                End If
            End If
        End With
    End If
End Sub

---

Update:

Sub CommandButton1_Click()
    Dim i As Long, j As Long
    Dim arrData, rngData As Range
    Dim arrRes, iR As Long
    Dim oSht1 As Worksheet, oSht2 As Worksheet
    Set oSht1 = Sheets("Sheet1")
    Set oSht2 = Sheets("Sheet2")
    Set rngData = oSht1.Range("A1").CurrentRegion
    arrData = rngData.Value
    ReDim arrRes(1 To UBound(arrData), 2)
    For i = LBound(arrData) To UBound(arrData)
        If Len(arrData(i, 3)) * Len(arrData(i, 4)) > 0 Then
            iR = iR + 1
            arrRes(iR, 0) = arrData(i, 1)
            arrRes(iR, 1) = arrData(i, 2)
            arrRes(iR, 2) = arrData(i, 5)
        End If
    Next i
    If iR > 0 Then
        oSht2.Cells.Clear
        oSht2.Range("A1").Resize(iR, 3).Value = arrRes
    End If
End Sub