View Full Version : [SOLVED:] Comparing lists of values, & adding unique values to the 1st blank cells of a range
jamesg
12-23-2013, 04:35 PM
Hi All,
I have 2 sheets with columns of numbers (A1:A500). I would like a macro that compares the 2 sets of numbers and adds any number unique to Sheet 1-Column A (ie. not in Sheet 2-Column A) to the 1st blank cell of Column A (on Sheet 2). I don't want a simple copy paste as the Sheet 2 list is sorted with adjacent values that need to stay unscrambled.
Any help is greatly appreciated.
James
westconn1
12-24-2013, 03:24 AM
try like
lastrw = Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row
For Each cel In Sheets("sheet1").Range("a1:a500")
Set fnd = Sheets("sheet2").Range("a1:A" & lastrw).Find(cel)
If fnd Is Nothing Then Sheets("sheet2").Range("a" & lastrw + 1).Value = cel
lastrw = lastrw + 1
Nextchange sheet names to suit
declare all variables etc
sassora
12-24-2013, 03:25 AM
Hi James
Is this the sort of thing you are after?
Option Explicit
Sub AddMissedValuesFromList()
Dim cellrange As Range
Dim lastrowSh2 As Long
lastrowSh2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
For Each cellrange In Sheets("Sheet1").Range("A1:A500").SpecialCells(2)
If IsError(Application.Match(cellrange, Sheets("Sheet2").Range("A1:A500"), 0)) Then
lastrowSh2 = lastrowSh2 + 1
Sheets("Sheet2").Range("A" & lastrowSh2) = cellrange.Value
End If
Next cellrange
End Sub
stanleydgrom
12-24-2013, 05:19 AM
jamesg,
The following works in my test environment.
Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).
Option Explicit
Sub AddUniquesToW2()
' stanleydgrom, 12/24/2013
' http://www.vbaexpress.com/forum/showthread.php?48521-Comparing-lists-of-values-amp-adding-unique-values-to-the-1st-blank-cells-of-a-range
Dim c As Range, frng As Range, lr As Long
lr = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Sheet1")
For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
If c <> "" Then
Set frng = Sheets("Sheet2").Columns(1).Find(c.Value)
If frng Is Nothing Then
lr = lr + 1
Sheets("Sheet2").Cells(lr, 1) = c.Value
End If
End If
Next c
End With
End Sub
Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm
Then run the AddUniquesToW2 macro.
jamesg
01-05-2014, 03:41 PM
Hi James
Is this the sort of thing you are after?
Option Explicit
Sub AddMissedValuesFromList()
Dim cellrange As Range
Dim lastrowSh2 As Long
lastrowSh2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
For Each cellrange In Sheets("Sheet1").Range("A1:A500").SpecialCells(2)
If IsError(Application.Match(cellrange, Sheets("Sheet2").Range("A1:A500"), 0)) Then
lastrowSh2 = lastrowSh2 + 1
Sheets("Sheet2").Range("A" & lastrowSh2) = cellrange.Value
End If
Next cellrange
End Sub
Hi Sassora,
This really great, almost perfect.
I should have mentioned in the original request that Sheet1-Column A5:A2005 values are index numbers so the whole column is populated 1 thru 2000, therefore this macro takes across all values including the heading in A4. Could you suggest and amendment that only takes the value unique to sheet1 across to sheet2 if the adjacent cell in Column C has the words "List" or "Pour" in it, or is not blank.
EG If number in A is not on sheet2 and the adjacent cell of column C is not blank, take it across and add it to the bottom of the list on sheet2.
Any help is greatly appreciated.
James
sassora
01-18-2014, 01:29 PM
Hi James - didn't notice your reply until now.
Amend the if statement below as relevant, currently only moves figures across if column C is not blank (and only looks a numbers in row 5 and above).
Sub AddMissedValuesFromList()
Dim lastrowSh2 As Long
lastrowSh2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Dim cel As Range
For Each cel In Sheets("Sheet1").Columns(1).SpecialCells(2)
If cel.Offset(, 2) <> "" and cel.row > 4 Then
If Sheets("Sheet2").Columns(1).Find(cel.Value) Is Nothing Then
lastrowSh2 = lastrowSh2 + 1
Sheets("Sheet2").Range("A" & lastrowSh2) = cel.Value
End If
End If
Next cel
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.