macro for checking rows?

[hurleypa2002]

Hello,

Looking for a macro that does the following:



row 1 re d p 21

row 2 d re 45 37

row 3 p 21 45 37


Compares any duplicate info from rows 1 and 2 and places non-row duplicates in row 3 (rows can be of unequaled length )

Thanks.

Pat.

 

[Gary McMaster]

Hi Pat,

Try this in a standard module.

Hope it helps.

Gary

Public Sub Test()

Dim oDict As Object
Dim vNode As Variant
Dim oCell As Range
Dim oInput As Range
Dim oOutput As Range

Set oInput = ActiveSheet.Range("1:2") 'Desired search range
Set oDict = CreateObject("scripting.dictionary")

oDict.RemoveAll

For Each oCell In oInput
    If oCell.Value <> "" Then
        If Not oDict.Exists(oCell.Value) Then
            oDict.Add oCell.Value, 0
        Else
            oDict(oCell.Value) = 1
        End If
    End If
Next oCell

Set oOutput = ActiveSheet.Range("A3") 'Desired output start

For Each vNode In oDict
    If oDict(vNode) = 0 Then
        oOutput.Value = vNode
        Set oOutput = oOutput.Offset(0, 1)
    End If
Next vNode

End Sub

 

[JoeMo]

Try this:

Sub UniquesToRow3()
Dim r As Range, vAr1 As Variant, vAr2 As Variant, vAr3 As Variant, rStr As String
Dim r1 As Range, r2 As Range

With Application
    .ScreenUpdating = False
End With
Set r = Range("A1:A2")
r.Offset(0, 1).Resize(1, 2).EntireColumn.Insert
vAr1 = Split(r.Cells(1).Value, " ")
vAr2 = Split(r.Cells(2).Value, " ")
Set r1 = Range("B1:B" & UBound(vAr1) - LBound(vAr1) + 1)
r1.Value = WorksheetFunction.Transpose(vAr1)
Set r2 = Range("C1:C" & UBound(vAr2) - LBound(vAr2) + 1)
r2.Value = WorksheetFunction.Transpose(vAr2)

For i = LBound(vAr1) To UBound(vAr1)
    If WorksheetFunction.CountIf(r2, r1.Cells(i + 1)) = 0 Then
            rStr = rStr & " " & r1.Cells(i + 1)
    End If
Next i
For i = LBound(vAr2) To UBound(vAr2)
    If WorksheetFunction.CountIf(r1, r2.Cells(i + 1)) = 0 Then
            rStr = rStr & " " & r2.Cells(i + 1)
    End If
Next i
r.Cells(2).Offset(1) = rStr
r1.EntireColumn.Delete
r2.EntireColumn.Delete
End Sub