Solved

# Excel compare and move

Posted on 2012-03-22
171 Views
Hi All,

I need a bit of excel help. I'm trying to compare part numbers in Column B to part numbers in Column A, If part numbers in column B do NOT exist in A then move Cell B and C content to new sheet.

Row 1 has Labels for columns.

I would really appreciate some help.
0
Question by:bcontent
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points

LVL 42

Accepted Solution

dlmille earned 500 total points
ID: 37756322
App compares data in column B with column A using countif formula in temporary column IS.  When B doesn't match a, it is copied with column C to new sheet called "Output" and marked for deletion.  At the end, column B:C no match rows are deleted, shifting the cells up as part of the process:

``````Option Explicit

Sub comparePartsAndMove()
Dim wkb As Workbook
Dim wks As Worksheet
Dim wksOut As Worksheet
Dim r As Range
Dim chkRange As Range
Dim rngA As Range
Dim rngB As Range
Dim lastRow As Long
Dim i As Long
Dim rDelete As Range

Application.ScreenUpdating = False

Set wkb = ThisWorkbook
Set wks = wkb.ActiveSheet

On Error Resume Next
Set wksOut = wkb.Sheets("Output")
If Err.Number = 0 Then
wksOut.Cells.Clear
Else
wksOut.Name = "Output"
End If
On Error GoTo 0

lastRow = wks.Range("B" & wks.Rows.Count).End(xlUp).Row

Set rngA = wks.Range("A2", wks.Range("A" & wks.Rows.Count).End(xlUp))
Set rngB = wks.Range("B2", wks.Range("B" & wks.Rows.Count).End(xlUp))

Set chkRange = wks.Range("IS2:IS" & lastRow) 'some column far to the right

chkRange.Formula = "=COUNTIF(" & rngA.Address & ",\$B2)"

chkRange.Value = chkRange.Value

i = 0
For Each r In wks.Range("IS2:IS" & lastRow)
If rDelete Is Nothing Then
Set rDelete = wks.Range("B" & r.Row & ":C" & r.Row)
Else
Set rDelete = Union(rDelete, wks.Range("B" & r.Row & ":C" & r.Row))
End If
wks.Range("B" & r.Row & ":C" & r.Row).Copy
wksOut.Range("A2").Offset(i, 0).PasteSpecial
Application.CutCopyMode = False
i = i + 1
End If
Next r

'clean up
wks.Range("IS:IS").ClearContents

'delete the rows to complete the move
If Not rDelete Is Nothing Then rDelete.Delete shift:=xlUp

MsgBox "Process Complete, hit enter to see results", vbOKOnly, "Success!"
wksOut.Activate

Application.ScreenUpdating = True

End Sub
``````

See attached.

Enjoy!

Dave
partCompare-r2.xls
0

Author Closing Comment

ID: 37758060
Hi dlmille,

Wow, you are amazing. Your solution worked Great. I was able to follow it clearly. The sample file really helped.

Thank you so much.
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

### Suggested Solutions

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
: Microsoft Office Collaborate for free and online versions of Microsoft  Word, Excel, Powerpoint, OneNote, Onedrive , Email, Calendar etc. In short we can say that Microsoft office is a suite of servers, applications and services developed by  Micrâ€¦
Viewers will learn what comprises a theme in Excel 2013, as well as how to customize them.
Viewers will learn various types of data validation for different data types in Excel 2013.