Solved: Paste on exact conditions

[justdriving]

Hi,

I wanted to copy cells from Sheet2 - Col A, B and D and paste it in Sheet1 - Col A, B and D.

I will perhaps prefer this method: -



Find end_of_row in COl A of Sheet1

Find end_of_Col in Row 1 of Sheet1

Run loop from 2 to end_of_row

Select A(LoopValue) from Sheet2, copy it

Find A(LoopValue)'s value in Col A of Sheet1.

If found, then

If AND (Sheet1.B(LoopValue).value = Sheet2.B(LoopValue).value, Sheet1.D(LoopValue).Value = Sheet2.D(LoopValue).value) then

I will paste Sheet2.A(LoopValue).value, Sheet2.B(LoopValue).value and Sheet2.D(LoopValue).value into Sheet1.A(end_of_row+1), Sheet1.B(end_of_row+1) and Sheet1.D(end_of_row+1), Sheet1.(end_of_row+1, end_of_col+1) = "Duplicate" respectively.

Else

I will paste Sheet2.A(LoopValue).value, Sheet2.B(LoopValue).value and Sheet2.D(LoopValue).value into Sheet1.A(end_of_row+1), Sheet1.B(end_of_row+1) and Sheet1.D(end_of_row+1)

End If

End If

End Loop

Condition 2: Font = Red in those rows which have "Duplicate" values.



I have difficulty in converting above algorithm to VBA program. I am looking for expert opinion.

There could be a better way to make this program. Looking to learn from experts in this forum.

I may modify or add some other conditions later. :stars:

[justdriving]

...

[justdriving]

...

[justdriving]

I wanted to update data in Sheet1 based on values from Sheet2.

Please refer attachment where
source is Sheet2 and
target is Sheet1

[justdriving]

I guess that I had missed something here: -



Sub writeval()

Inc = Inc + 1

ThisWorkbook.Sheets(1).Cells(endRowSh1 + Inc, 1).Value = ThisWorkbook.Sheets(2).Cells(RinSh2, 1).Value
ThisWorkbook.Sheets(1).Cells(endRowSh1 + Inc, 3).Value = ThisWorkbook.Sheets(2).Cells(RinSh2, 3).Value
ThisWorkbook.Sheets(1).Cells(endRowSh1 + Inc, 4).Value = ThisWorkbook.Sheets(2).Cells(RinSh2, 4).Value

End Sub



Sub test()

Dim endRowSh1, endColSh1, endRowSh2, endColSh2 As Long
Dim RinSh1, RinSh2, Inc As Integer

Inc = 0

'Find end_of_row In COl A of Sheet1
'Find end_of_Col In Row 1 of Sheet1

With ThisWorkbook.Sheets(1)
endRowSh1 = .Cells(Rows.Count, 1).End(xlUp).Row
endColSh1 = .Cells(1, Columns.Count).End(xlToLeft).Column
End With

With ThisWorkbook.Sheets(2)
endRowSh2 = .Cells(Rows.Count, 1).End(xlUp).Row
endColSh2 = .Cells(1, Columns.Count).End(xlToLeft).Column
End With

'Run Loop from 2 To end_of_row
For RinSh2 = 2 To endRowSh2

For RinSh1 = 2 To endRowSh1

If ThisWorkbook.Sheets(2).Cells(RinSh2, 1).Value = ThisWorkbook.Sheets(1).Cells(RinSh1, 1).Value Then

If ThisWorkbook.Sheets(2).Cells(RinSh2, 3).Value = ThisWorkbook.Sheets(1).Cells(RinSh1, 3).Value Then

If ThisWorkbook.Sheets(2).Cells(RinSh2, 4).Value = ThisWorkbook.Sheets(1).Cells(RinSh1, 4).Value Then

Else

call writeval

End If

End If

End If

Next RinSh1

Next RinSh2
End Sub

[justdriving]

Ignore this thread , please. I am sorry for this inconvenience. If possible, please delete this thread.

[justdriving]

Answer:



Sub test()

Dim endRowSh1, endColSh1, endRowSh2, endColSh2 As Long
Dim inSh1, inSh2, Inc As Integer
Dim Found As Boolean
Dim Sh2RnC1, Sh1RnC1 As Long
Dim Sh2RnC3, Sh1RnC3 As Date
Dim Sh2RnC4, Sh1RnC4 As String


Inc = 0

'Find end_of_row In COl A of Sheet1
'Find end_of_Col In Row 1 of Sheet1

With ThisWorkbook.Sheets(1)
endRowSh1 = .Cells(Rows.Count, 1).End(xlUp).Row
endColSh1 = .Cells(1, Columns.Count).End(xlToLeft).Column
End With

With ThisWorkbook.Sheets(2)
endRowSh2 = .Cells(Rows.Count, 1).End(xlUp).Row
endColSh2 = .Cells(1, Columns.Count).End(xlToLeft).Column
End With

'Run Loop from 2 To end_of_row


For inSh2 = 2 To endRowSh2

Found = False

For inSh1 = 2 To endRowSh1

Sh2RnC1 = ThisWorkbook.Sheets(2).Cells(inSh2, 1).Value
Sh1RnC1 = ThisWorkbook.Sheets(1).Cells(inSh1, 1).Value

Sh2RnC3 = ThisWorkbook.Sheets(2).Cells(inSh2, 3).Value
Sh1RnC3 = ThisWorkbook.Sheets(1).Cells(inSh1, 3).Value

Sh2RnC4 = ThisWorkbook.Sheets(2).Cells(inSh2, 4).Value
Sh1RnC4 = ThisWorkbook.Sheets(1).Cells(inSh1, 4).Value


If Sh2RnC1 = Sh1RnC1 And Sh2RnC3 = Sh1RnC3 And Sh2RnC4 = Sh1RnC4 Then

Found = True

End If


Next inSh1

If Found = False Then

Inc = Inc + 1

ThisWorkbook.Sheets(1).Cells(endRowSh1 + Inc, 1).Value = ThisWorkbook.Sheets(2).Cells(inSh2, 1).Value
ThisWorkbook.Sheets(1).Cells(endRowSh1 + Inc, 3).Value = ThisWorkbook.Sheets(2).Cells(inSh2, 3).Value
ThisWorkbook.Sheets(1).Cells(endRowSh1 + Inc, 4).Value = ThisWorkbook.Sheets(2).Cells(inSh2, 4).Value


End If


Next inSh2

End Sub