CODEWITHSUNDEEP
vbaexcelvlookup
FotoDJ
FotoDJ

Reputation: 351

VBA Excel match Copy Paste If Else

If Cell.value from Sheet2.Column"A" has no match in Sheet("Civil").Column"A" than copy that cell into Sheets("Sheet2).Column "D"

Correct Results

Correct result should look like on the attached picture but I have problem with writing a correct code to fill Sheets("Sheet2).Column "D" 

  Sub NewSearch_A()

 Dim cell As Range, rng As Range, rng2 As Range, rng3 As Range, cell1 As Range, n As Integer, m As Integer
Set rng = Sheets("Civil").Range("A2:A1000")
Set rng2 = Sheets("Sheet2").Range("A1:A100")
Set rng3 = Sheets("Sheet2").Range("C1:C100")
Set rng4 = Sheets("Sheet2").Range("D1:D100")

n = 1
m = 1
For Each cell In rng
    n = n + 1
For Each cell1 In rng2
    m = m + 1
        If cell.Value = cell1.Value Then
            Sheets("Sheet2").Range("C" & m & ":C" & m).Value = Sheets("Civil").Range("B" & n & ":B" & n).Value

         Else

            ' ????????????????????????????????????????????????


        End If
    Next cell1
    m = 1
Next cell
 ActiveSheet.Columns("A:C").AutoFit


End Sub

Upvotes: 1

Views: 767

Answers (1)

user4039065
user4039065

Reputation:

Avoid the second loop with a WorksheetFunction MATCH function.

Sub NewSearch_A()
    Dim rw As Long, mtch As Variant, wsc As Worksheet

    Set wsc = Worksheets("Civil")

    With Worksheets("Sheet2")
        For rw = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            mtch = Application.Match(.Cells(rw, "A").Value2, wsc.Columns("A"), 0)
            If IsError(mtch) Then
                .Cells(rw, "D") = .Cells(rw, "A").Value2
            Else
                .Cells(rw, "C") = wsc.Cells(mtch, "B").Value2
            End If
        Next rw
    End With

End Sub

Upvotes: 2

Related Questions