Varinace given the destination name

[mariamhalday]

Hi ,

One more help needed with the experts here . I have sheet with data in column A ,column B Its a numeric data. I want compare two columns with each other and copy the unigue values to column C. As the number can be repeated multiple times in each columns. Against each unique value I want the variance of that value in Columns D. Further in Column E against the unique value If variance is found then Mark in which column the variance is found (Eg: ColumnA or ColumnB .
I searched a lot n many forum and finally got code .I have the code which works fine .It gives results up to variance found but I wanted a little extra .I wanted to know in which column the variance is present . If some one could help me with this I would really thankful.

Thanks n advance.

CODE:

<tbody>
</tbody>

<style> .ExternalClass .ecxhmmessage P { padding:0px; } .ExternalClass body.ecxhmmessage { font-size:12pt; font-family:Calibri; } </style> Sub countVar()
Dim sh As Worksheet, lr As Long, rng As Range
Set sh = Sheets(1)
lr = sh.Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row
Set rng = sh.Range("A2:A" & lr)
For Each c In rng
If Application.CountIf(sh.Range("C2:C" & lr), c.Value) = 0 Then
sh.Cells(Rows.Count, 3).End(xlUp)(2) = c.Value
x = Application.CountIf(rng, c.Value)
y = Application.CountIf(sh.Range("B2:B" & lr), c.Value)
If x = y Then
sh.Cells(Rows.Count, 3).End(xlUp).Offset(0, 1) = x
sh.Cells(Rows.Count, 3).End(xlUp).Offset(0, 2) = 0
Else

If x > y Then
sh.Cells(Rows.Count, 3).End(xlUp).Offset(0, 1) = x
Else
sh.Cells(Rows.Count, 3).End(xlUp).Offset(0, 1) = y
End If
sh.Cells(Rows.Count, 3).End(xlUp).Offset(0, 2) = Abs(x - y)
End If
End If
Next
For Each c In Range("B2:B" & lr)
If Application.CountIf(sh.Range("C2:C" & lr), c.Value) = 0 Then
sh.Cells(Rows.Count, 3).End(xlUp)(2) = c.Value
x = Application.CountIf(rng, c.Value)
y = Application.CountIf(sh.Range("B2:B" & lr), c.Value)
If x = y Then
sh.Cells(Rows.Count, 3).End(xlUp).Offset(0, 1) = x
sh.Cells(Rows.Count, 3).End(xlUp).Offset(0, 2) = 0
Else

If x > y Then
sh.Cells(Rows.Count, 3).End(xlUp).Offset(0, 1) = x
Else
sh.Cells(Rows.Count, 3).End(xlUp).Offset(0, 1) = y
End If
sh.Cells(Rows.Count, 3).End(xlUp).Offset(0, 2) = Abs(x - y)
End If
End If
Next
End Sub