VBA Compare 2 sheets, move old comments to new sheet - excel

Question

Basically i have this script which compare 2 sheets, which compares a value in a column to the new sheet, if it finds the value, it will copy the information from Old sheet "B" to new sheet "B" column.
The script is working flawlessly (Thanks to the author)
I have trying to configure it to search and compare not only 1 column, but 2, if column X AND Y are equal to X AND Y in the new sheet it will do the same task.
The reason for this is that sometimes i have the value it searches for in few different rows, so when it compares it will find it at few places. While this script works perfect only when there are unique "Find" values.
Can you help me to edit so it fits "Find" and compare Column "P" & Column "V" if those are the same in new sheet, it will copy the Values in Column "B" old sheet to "B" new sheet.
Sub movecommentsInternode()
Dim Wb As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim rSourcePCol As Range
Dim rSourcePCell As Range
Dim rDestPCol As Range
Dim rFound As Range
Dim sFirst As String
Dim sNotFound As String
Set Wb = ActiveWorkbook
Set wsSource = Wb.Sheets("Internode Buffer")
Set wsDest = Wb.Sheets("DataInternode")
Set rSourcePCol = wsSource.Range("P2", wsSource.Cells(wsSource.Rows.Count, "P").End(xlUp))
Set rDestPCol = wsDest.Range("P2", wsDest.Cells(wsDest.Rows.Count, "P").End(xlUp))
If rSourcePCol.row < 2 Then
MsgBox "No comment available, therefor no import is needed " ' & wsSource.Name
Exit Sub
ElseIf rDestPCol.row < 2 Then
MsgBox "Data Sheet is empty, please import the correct IO-List to be able to merge the comments " ' & wsDest.Name
Exit Sub
End If
For Each rSourcePCell In rSourcePCol.Cells
Set rFound = rDestPCol.Find(rSourcePCell.Value, rDestPCol.Cells(rDestPCol.Cells.Count), xlValues, xlWhole)
If rFound Is Nothing Then
sNotFound = sNotFound & Chr(10) & rSourcePCell.Value
Else
sFirst = rFound.Address
Do
rFound.Offset(, -14).Value = rSourcePCell.Offset(, -14).Value
Set rFound = rDestPCol.FindNext(rFound)
Loop While rFound.Address <> sFirst
End If
Next rSourcePCell
If Len(sNotFound) = 0 Then
MsgBox ("Import completed" & vbCrLf & "All comments have been merged with the new imported IO-List")
Else
MsgBox ("Import completed" & vbCrLf & "The following tag-comments have not been merged with new IO-List:" & sNotFound)
End If
End Sub
Also as a extra thing: Can you help me make it show the missing tags in a list (New sheet) insted of as comment. Will be ackward if there is hundreds of missing tags showing all in Msgbox.

Answer 1

Give this a try:
Sub movecommentsInternode()
Dim Wb As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim wsMissingTags As Worksheet
Dim rSourcePCol As Range
Dim rSourcePCell As Range
Dim rDestPCol As Range
Dim rFound As Range
Dim sFirst As String
Dim sNotFound As String
Dim bFound As Boolean
Dim aHeaders() As Variant
Dim aMissingTags As Variant
Set Wb = ActiveWorkbook
Set wsSource = Wb.Sheets("Internode Buffer")
Set wsDest = Wb.Sheets("DataInternode")
Set rSourcePCol = wsSource.Range("P2", wsSource.Cells(wsSource.Rows.Count, "P").End(xlUp))
Set rDestPCol = wsDest.Range("P2", wsDest.Cells(wsDest.Rows.Count, "P").End(xlUp))
If rSourcePCol.Row < 2 Then
MsgBox "No comment available, therefor no import is needed " ' & wsSource.Name
Exit Sub
ElseIf rDestPCol.Row < 2 Then
MsgBox "Data Sheet is empty, please import the correct IO-List to be able to merge the comments " ' & wsDest.Name
Exit Sub
End If
For Each rSourcePCell In rSourcePCol.Cells
bFound = False
Set rFound = rDestPCol.Find(rSourcePCell.Value, rDestPCol.Cells(rDestPCol.Cells.Count), xlValues, xlWhole)
If Not rFound Is Nothing Then
sFirst = rFound.Address
Do
If rSourcePCell.Offset(, 6).Value = rFound.Offset(, 6).Value Then
rFound.Offset(, -14).Value = rSourcePCell.Offset(, -14).Value
bFound = True
End If
If bFound = True Then Exit Do 'First match for both columns found, exit find loop (this line can be removed if preferred)
Set rFound = rDestPCol.FindNext(rFound)
Loop While rFound.Address <> sFirst
End If
If bFound = False Then sNotFound = sNotFound & "|" & rSourcePCell.Value & vbTab & rSourcePCell.Offset(, 6).Value
Next rSourcePCell
If Len(sNotFound) = 0 Then
MsgBox ("Import completed" & vbCrLf & "All comments have been merged with the new imported IO-List")
Else
On Error Resume Next
Set wsMissingTags = Wb.Worksheets("Missing Tags")
On Error GoTo 0
If wsMissingTags Is Nothing Then
'Missing Tags worksheet doesn't exist, create it and add headers
aHeaders = Array(wsSource.Range("P1").Value, wsSource.Range("V1").Value)
Set wsMissingTags = Wb.Worksheets.Add(After:=Wb.Worksheets(Wb.Worksheets.Count))
wsMissingTags.Name = "Missing Tags"
With wsMissingTags.Range("A1").Resize(, UBound(aHeaders) - LBound(aHeaders) + 1)
.Value = aHeaders
.Font.Bold = True
.Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
Else
'Missing Tags worksheet already exists, clear previous contents (if any)
wsMissingTags.Range("A1").CurrentRegion.Offset(1).ClearContents
End If
aMissingTags = Split(Mid(sNotFound, 2), "|")
With wsMissingTags.Range("A2").Resize(UBound(aMissingTags) - LBound(aMissingTags) + 1)
.Value = Application.Transpose(aMissingTags)
.TextToColumns .Cells, xlDelimited, Tab:=True
End With
MsgBox "Import completed" & vbCrLf & "See the Missing Tags worksheet for a list of tag-comments that have not been merged with new IO-List."
End If
End Sub

Answer 2

It is a fine code. I modified and tried it and find working as per my understanding of your requirement The modified full code is:
Sub movecommentsInternode()
Dim Wb As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim rSourceHCol As Range
Dim rDestHCol As Range
Dim rdestHCell As Range
Dim rSourceHCell As Range
Dim rSourceHCol2 As Range 'added
Dim rDestHCol2 As Range 'added
Dim rSourceHCell2 As Range 'added
Dim rdestHCell2 As Range 'added
Dim rFound As Range
Dim sFirst As String
Dim sNotFound As String
Set Wb = ActiveWorkbook
Set wsSource = Wb.Sheets("Internode Buffer")
Set wsDest = Wb.Sheets("DataInternode")
Set rSourceHCol = wsSource.Range("H2", wsSource.Cells(wsSource.Rows.Count, "H").End(xlUp))
Set rDestHCol = wsDest.Range("H2", wsDest.Cells(wsDest.Rows.Count, "H").End(xlUp))
'Next two lines added
Set rSourceHCol2 = wsSource.Range("V2", wsSource.Cells(wsSource.Rows.Count, "V").End(xlUp))
Set rDestHCol2 = wsDest.Range("V2", wsDest.Cells(wsDest.Rows.Count, "V").End(xlUp))
If rSourceHCol.Row < 2 Or rSourceHCol2.Row < 2 Then ' condition modified
MsgBox "No comment available, therefor no import is needed " ' & wsSource.Name
Exit Sub
ElseIf rDestHCol.Row < 2 Or rDestHCol2.Row < 2 Then ' condition modified
MsgBox "Data Sheet is empty, please import the correct IO-List to be able to merge the comments " ' & wsDest.Name
Exit Sub
End If
For Each rSourceHCell In rSourceHCol.Cells
Set rSourceHCell2 = rSourceHCell.Offset(0, 14) 'corresponding value in V Col Source Sheet
Set rFound = rDestHCol.Find(rSourceHCell.Value, rDestHCol.Cells(rDestHCol.Cells.Count), xlValues, xlWhole)
If rFound Is Nothing Then
sNotFound = sNotFound & Chr(10) & rSourceHCell.Value
Else
sFirst = rFound.Address
Do
'Next two lines and if clause added
Set rdestHCell2 = rFound.Offset(0, 14) 'corresponding value in V Col Destination Sheet
If rSourceHCell2.Value = rdestHCell2.Value Then ' added
rFound.Offset(0, -6).Value = rSourceHCell.Offset(0, -6).Value 'offset from H to B
End If
Set rFound = rDestHCol.FindNext(rFound)
Loop While rFound.Address <> sFirst
End If
Next rSourceHCell
If Len(sNotFound) = 0 Then
MsgBox ("Import completed" & vbCrLf & "All comments have been merged with the new imported IO-List")
Else
MsgBox ("Import completed" & vbCrLf & "The following tag-comments have not been merged with new IO-List:" & sNotFound)
End If
End Sub
Edit: line Set rSourceHCell2 = rSourceHCell.Offset(0, 14) moved after line For Each rSourceHCell In rSourceHCol.Cells . If it does not work try to use If StrComp(rSourceHCell2.Value, rDestHCell2.Value) = 0 Then in place of If rSourceHCell2.Value = rdestHCell2.Value Then