find and delete duplicate entries in two columns or find and prin.
This routine works with four columns (2 for keys, 2 for data to
compare). Use it as a guide for your needs:
Option Explicit
Sub xJuxtapose()
' Routine aligns two, two column sets to identify the missing keys. Columns
A and C
' contain the keys while columns B and D hold whatever needs additional
comparison.
Dim intROW As Integer
Dim intLeftCol As Integer, intRightCol As Integer
intROW = 2 ' presumes a single header row
intLeftCol = 1
intRightCol = 3
While Cells(intROW, intLeftCol) < "" And Cells(intROW, intRightCol) < ""
If UCase(Cells(intROW, intLeftCol)) < UCase(Cells(intROW, intRightCol))
Then
If UCase(Cells(intROW, intLeftCol)) < UCase(Cells(intROW,
intRightCol)) Then Range(Cells(intROW, intRightCol), Cells(intROW,
intRightCol + 1)).Select
If UCase(Cells(intROW, intLeftCol)) UCase(Cells(intROW,
intRightCol)) Then Range(Cells(intROW, intLeftCol), Cells(intROW, intLeftCol
+ 1)).Select
Cells(intROW, intRightCol + 2) = "MISS"
Selection.Insert Shift:=xlDown
Else
If UCase(SQUISH(Cells(intROW, intRightCol + 1))) <
UCase(SQUISH(Cells(intROW, intLeftCol + 1))) Then
Cells(intROW, intRightCol + 1).Font.ColorIndex = 3
Cells(intROW, intRightCol + 2) = "DESC" ' merely flag that a
difference exists
End If
End If
intROW = intROW + 1
Wend
Cells(1, 1).Select
Beep
End Sub
Private Function SQUISH(strValue As String) As String
' Routine makes sure that the incoming string has no blanks in it.
Dim intI As Integer ' working variable
SQUISH = ""
For intI = 1 To Len(strValue)
If Mid(strValue, intI, 1) < " " Then SQUISH = SQUISH & Mid(strValue,
intI, 1)
Next intI
End Function
Guess what? Freeware doesn't come with warranties of absolutely any
sort.
Steve in Ohio
"campare 2 columns of numbers-find unique" wrote:
i have a set of inventory numbers that copy to an excel spreadsheet daily and
compare to yesterdays to see what had been dropped. how to i write a macro to
compare the two columns and give me only new entys in second column that have
no match in first column?
|