CODEWITHSUNDEEP
excelvba
T. Patel
T. Patel

Reputation: 25

Excel VBA: Im trying to compare data from sheets1 with some condition to data in sheet2 and transfer only unmatched data to sheet2

** sheet1 data as following;

rows from 11 to 15

column B 101, 102, 103, 104, 105

column C test1, test2, test3, test4, test5

column D 12/1/15, 12/1/15, 12/2/15, 12/1/15, 12/1/15

column E 12/6/15, 12/7/15, 12/2/15, 11/30/15, 12/15/15

sheet2 data as following;

row 11

column B 101

column C test1

column D 12/1/15

column E 12/6/15

Let’s assume today is 12/5/15. What Im trying here is that I want to see if E11 is > then today in sheet1, if yes then compare the value of B11 from sheet1 to list of B in sheet2. IF the value find in column B in sheet to then check for E12 and continue. And if the value did not found in column B in sheet to then I want to copy B11 to E11 from sheet1 to next empty row in sheet 2.

So the code should only copy rows 12 and 15 from sheet1 and put that in sheet2 in rows 12 and 13. Im running following code but its copying all rows from sheet1, and if I run again its duplicating each row multiples time. **

Dim lastrow1 As Long
Dim lastrow2 As Long
Dim erow As Long
Dim name1 As String
Dim name2 As String

lrow1 = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
lrow2 = Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row

For i = 11 To lrow1
    name1 = Sheets("Sheet1").Cells(i, "C").Value

    For j = 11 To lrow2
        name2 = Sheets("Sheet2").Cells(j, "C").Value

        If Sheets("Sheet1").Cells(i, 5) > Date And name1 <> name2 Then

            Sheets("Sheet1").Activate
            Sheets("Sheet1").Range(Cells(i, "B"), Cells(i, "E")).Copy
            Sheets("Sheet2").Activate
            erow = Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
            Sheets("Sheet2").Range(Cells(erow, "B"), Cells(erow, "E")).Select
            ActiveSheet.Paste

        End If

    Next j
    Application.CutCopyMode = False

Next i

Upvotes: 1

Views: 118

Answers (1)

Scott Craner
Scott Craner

Reputation: 152505

This should do it.

Sub cpypste()

Dim lastrow1 As Long
Dim lastrow2 As Long
Dim erow As Long
Dim name1 As String
Dim name2 As String
Dim hre As Boolean

lrow1 = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
lrow2 = Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row

For i = 11 To lrow2
    name1 = Sheets("Sheet1").Cells(i, "C").Value
    hre = False
    For j = 10 To lrow2
        name2 = Sheets("Sheet2").Cells(j, "C").Value

        If Sheets("Sheet1").Cells(i, 5) <= Date Or name1 = name2 Then            
            hre = True    
        End If

    Next j
    If Not hre Then
        Application.CutCopyMode = False
        Sheets("Sheet1").Range(Sheets("Sheet1").Cells(i, "B"), Sheets("Sheet1").Cells(i, "E")).Copy
        erow = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, 2).End(xlUp).Offset(1, 0).Row
        Sheets("Sheet2").Range(Sheets("Sheet2").Cells(erow, "B"), Sheets("Sheet2").Cells(erow, "E")).PasteSpecial
        Sheets("Sheet2").Range("F"&erow).value = "S/O"
    End If
Next i
End Sub

The problem is you need to go through the full second loop before knowing if the row exists or not.

Upvotes: 2

Related Questions