Add Data To a New Sheet

Question

I have a data validation list value which my macro will copy data to a specific place in the workbook based on this value. However, when a value is selected from the data validation list the macro skips the IF statement, as if the statement is false. Could you please help me understand why this is happening? If I remove the data validation, the macro works as expected. Thank You!

Sub AddToList()
    
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lRow1 As Long
    Dim lRow2 As Long
    Dim lRow3 As Long
    Dim lRow4 As Long
    
    Application.ScreenUpdating = False
    
    Set ws1 = ThisWorkbook.Worksheets("DILUTION CALCULATOR")
    Set ws2 = ThisWorkbook.Worksheets("SETUP")
    
    lRow1 = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    lRow2 = ws2.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row
    lRow3 = ws2.Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).Row
    lRow4 = ws2.Cells(Rows.Count, 13).End(xlUp).Offset(1, 0).Row
    
    If ws1.Range("M4") = "" Or ws1.Range("O4") = "" Or ws1.Range("Q4") = "" Then
        MsgBox "Please Enter Data In All Fields", vbCritical
        Exit Sub
    ElseIf ws1.Range("M4") = "Customer" Then
        ws1.Range("O4 , Q4").Copy
        ws2.Cells(lRow1, 1).PasteSpecial Paste:=xlValues
    ElseIf ws1.Range("M4") = "Order Number" Then
        ws1.Range("O4 , Q4").Copy
        ws2.Cells(lRow2, 5).PasteSpecial Paste:=xlValues
    ElseIf ws1.Range("M4") = "Quantity" Then
        ws1.Range("O4 , Q4").Copy
        ws2.Cells(lRow3, 9).PasteSpecial Paste:=xlValues
    ElseIf ws1.Range("M4") = "Status" Then
        ws1.Range("O4 , Q4").Copy
        ws2.Cells(lRow4, 13).PasteSpecial Paste:=xlValues
    End If
    
    ws1.Range("M4, O4, Q4").ClearContents
    
    Application.ScreenUpdating = True
    
End Sub

user_9814069 · Answer

Copy to Another Worksheet

Option Explicit

Sub AddToList()

    Const sName As String = "DILUTION CALCULATOR"
    Const srgAddress As String = "M4,O4,Q4" ' at least two cells
    
    Const dName As String = "SETUP"
    ' Both arrays have to have the same number of elements.
    Dim dCols As Variant: dCols = VBA.Array(1, 5, 9, 13)
    Dim Criteria As Variant
    Criteria = VBA.Array("Customer", "Order Number", "Quantity", "Status")
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim srg As Range: Set srg = sws.Range(srgAddress)
    Dim cCount As Long: cCount = srg.Cells.Count
    
    Dim sCell As Range
    
    For Each sCell In srg.Cells
        If Len(CStr(sCell.Value)) = 0 Then
            MsgBox "Please enter data in all fields.", vbCritical
            Exit Sub
        End If
    Next sCell
    
    Dim cIndex As Variant
    cIndex = Application.Match(CStr(srg.Cells(1).Value), Criteria, 0)
    
    If IsError(cIndex) Then
        MsgBox "Criteria not found.", vbCritical
        Exit Sub
    End If
        
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim drg As Range: Set drg = dws.Cells(dws.Rows.Count, dCols(cIndex - 1)) _
        .End(xlUp).Offset(1).Resize(, cCount - 1)
    
    Dim dc As Long
    
    For Each sCell In srg.Cells
        If dc > 0 Then
            drg.Cells(dc).Value = sCell.Value
        End If
        dc = dc + 1
    Next sCell
    
    srg.ClearContents
    
End Sub

Add Data To a New Sheet

1 Answers

Copy to Another Worksheet