Want to compare sheet1 column C list to sheet2 column H list and if match copy column H row A to Z to Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp)(2).

Errors out on the varOut = MyArr2(ii).Offset(, -7).Resize(1, 26).

I am aware that MyArr2 only sees the range on sheet2 as cells H1:H2, while MyArr1 shows 10 elements...??? So for sure the code is going to fail on that alone, but this is my shot at it.

Here is what the compare columns hold on sheet1 & sheet2. So the only sheet2 rows A to Z that would NOT get copied to sheet3 are 33 and 44. No match.

Code is in standard module.
Trying to use arrays to avoid the slow "For each c in First Range" & "For each cc in Second Range", but almost looks like that is what I am doing with the arrays.

Howard


1 8
2 7
3 6
4 5
11 33
5 4
6 3
7 2
8 1
22 44


Sub ColumnsCompare()

Dim i As Long, ii As Long

Dim MyArr1 As Variant
Dim MyArr2 As Variant

Dim varOut As Variant

MyArr1 = Sheets("Sheet1").Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row).Value
MyArr2 = Sheets("Sheet2").Range("H2:H" & Cells(Rows.Count, "H").End(xlUp).Row).Value

Application.ScreenUpdating = False


For i = LBound(MyArr1) To UBound(MyArr1)

For ii = LBound(MyArr2) To UBound(MyArr2)

If MyArr1(i, 1) = MyArr2(ii, 1) Then

'/ set the data to copy
varOut = MyArr2(ii).Offset(, -7).Resize(1, 26)

Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp)(2) = varOut

End If

Next 'ii

Next 'i

Application.ScreenUpdating = True
End Sub

Hi Howard,

Am Wed, 11 Feb 2015 17:00:22 -0800 (PST) schrieb L. Howard:

Want to compare sheet1 column C list to sheet2 column H list and if match copy column H row A to Z to Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp)(2).

Errors out on the varOut = MyArr2(ii).Offset(, -7).Resize(1, 26).

I am aware that MyArr2 only sees the range on sheet2 as cells H1:H2, while MyArr1 shows 10 elements...??? So for sure the code is going to fail on that alone, but this is my shot at it.

Here is what the compare columns hold on sheet1 & sheet2. So the only sheet2 rows A to Z that would NOT get copied to sheet3 are 33 and 44. No match.

better use a range for outputthan an array.
Try:

Sub ColumnsCompare()

Dim i As Long, ii As Long, n As Long

Dim MyArr1 As Variant
Dim MyArr2 As Variant
Dim rngBig As Range

MyArr1 = Sheets("Sheet1").Range("C2:C" & _
Cells(Rows.Count, "C").End(xlUp).Row).Value
MyArr2 = Sheets("Sheet2").Range("H2:H" & _
Cells(Rows.Count, "H").End(xlUp).Row).Value

Application.ScreenUpdating = False

For i = LBound(MyArr1) To UBound(MyArr1)
For ii = LBound(MyArr2) To UBound(MyArr2)
If MyArr1(i, 1) = MyArr2(ii, 1) Then
If rngBig Is Nothing Then
Set rngBig = Sheets("Sheet2").Range _
(Cells(ii + 1, 1), Cells(ii + 1, 26))
Else
Set rngBig = Union(rngBig, Sheets("Sheet2") _
.Range(Cells(ii + 1, 1), Cells(ii + 1, 26)))
End If
End If
Next 'ii
Next 'i
Sheets("Sheet3").Range("A1").Resize(rngBig.Rows.Co unt, _
rngBig.Columns.Count).Value = rngBig.Value

Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Thu, 12 Feb 2015 08:12:12 +0100 schrieb Claus Busch:

Sheets("Sheet3").Range("A1").Resize(rngBig.Rows.Co unt, _
rngBig.Columns.Count).Value = rngBig.Value

change this output command to:

If Not rngBig Is Nothing Then
Sheets("Sheet3").Range("A1").Resize(rngBig.Rows.Co unt, _
rngBig.Columns.Count).Value = rngBig.Value
Else
MsgBox "no matches found"
End If


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Basically, you're treating your array as though it's a range. Since
it's just a data container, .Offset and .Resize don't apply.

Claus' suggestion is an easier approach even though it doesn't help you
with handling arrays. Now if you loaded the entire sheet (ergo
..UsedRange) into at least 1 array and looped the search criteria
through a column 'Index' of that array then you could grab matches and
just 'dump' the 26 cols into the target row...

Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp)(2).Resize(1, 26) _
= Application.Index(MyArr2, ii, 0)

...where MyArr2 is the search/source data from Sheet2, and MyArr1 is the
criteria from Sheet1. If there's more than 26 cols in UsedRange it
doesn't matter because you'll only dump data that fits Resize.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Howrd,

Am Wed, 11 Feb 2015 17:00:22 -0800 (PST) schrieb L. Howard:

MyArr1 = Sheets("Sheet1").Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row).Value
^^^^^
Cells(Rows.count.... is not correctly refered.
If you start the macro from Sheet3 and Sheet3 is empty this will be 0.
You have to refer this to the expectd sheet:

MyArr1 = Sheets("Sheet1").Range("C2:C" & Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row)
or you first calculate the last row:

LRow1 = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
MyArr1 = Sheets("Sheet1").Range("C2:C" & LRow1)

with my code it would look like:

Sub ColumnsCompare()

Dim i As Long, ii As Long
Dim LRow1 As Long, Lrow2 As Long
Dim MyArr1 As Variant
Dim MyArr2 As Variant
Dim rngBig As Range

LRow1 = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
MyArr1 = Sheets("Sheet1").Range("C2:C" & LRow1)
Lrow2 = Sheets("Sheet2").Cells(Rows.Count, "H").End(xlUp).Row
MyArr2 = Sheets("Sheet2").Range("H2:H" & Lrow2)

Application.ScreenUpdating = False

With Sheets("Sheet2")
For i = LBound(MyArr1) To UBound(MyArr1)
For ii = LBound(MyArr2) To UBound(MyArr2)
If MyArr1(i, 1) = MyArr2(ii, 1) Then
If rngBig Is Nothing Then
Set rngBig = .Range(.Cells(ii + 1, 1), .Cells(ii + 1, 26))
Else
Set rngBig = Union(rngBig, _
.Range(.Cells(ii + 1, 1), .Cells(ii + 1, 26)))
End If
End If
Next 'ii
Next 'i
End With
If Not rngBig Is Nothing Then
Sheets("Sheet3").Range("A1").Resize(rngBig.Rows.Co unt, _
rngBig.Columns.Count).Value = rngBig.Value
Else
MsgBox "no matches found"
End If

Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Wed, 11 Feb 2015 17:00:22 -0800 (PST) schrieb L. Howard:

Want to compare sheet1 column C list to sheet2 column H list and if match copy column H row A to Z to Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp)(2).

you also could copy the range A2:Z & Lrow to sheet3 and delete the rows
that do not match:

Sub ColumnsCompare2()

Dim i As Long, n As Long
Dim LRow1 As Long, LRow2 As Long
Dim MyArr As Variant


LRow1 = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
LRow2 = Sheets("Sheet2").Cells(Rows.Count, "H").End(xlUp).Row
MyArr = Sheets("Sheet2").Range("H2:H" & LRow2)

Application.ScreenUpdating = False

Sheets("Sheet2").Range("A2:Z" & LRow2).Copy
Sheets("Sheet3").Range("A1").PasteSpecial xlPasteValues

With WorksheetFunction
For i = LBound(MyArr) To UBound(MyArr)
If .CountIf(Sheets("Sheet1").Range("C:C"), MyArr(i, 1)) 0 Then
GoTo myNext
Else
n = .Match(MyArr(i, 1), Sheets("Sheet3").Range("H1:H" & LRow2), 0)
End If
Sheets("Sheet3").Rows(n).Delete
myNext: Next
End With

Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Optionally...

Sub ColumnsCompare2()
Dim n&, j&, lLastRow
Dim v1, v2, rngBig As Range

Const lStartRow& = 2

Application.ScreenUpdating = False
On Error GoTo ErrExit

lLastRow = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
MyArr1 = Sheets("Sheet1").Range("C2:C" & lLastRow)

With Sheets("Sheet2")
lLastRow = .Cells(Rows.Count, "H").End(xlUp).Row
MyArr2 = .Range("H2:H" & lLastRow)
For n = lStartRow To UBound(MyArr1)
For j = lStartRow To UBound(MyArr2)
If MyArr1(n, 1) = MyArr2(j, 1) Then
If rngBig Is Nothing Then
Set rngBig = .Range(.Cells(j, 1), .Cells(j, 26))
Else
Set rngBig = Union(rngBig, _
.Range(.Cells(j, 1), .Cells(j, 26)))
End If
End If
Next 'j
Next 'n
End With
If Not rngBig Is Nothing Then
Sheets("Sheet3").Range("A1").Resize(rngBig.Rows.Co unt, _
rngBig.Columns.Count).value = rngBig.value
Else
MsgBox "no matches found"
End If

ErrExit:
Set rngBig = Nothing
Application.ScreenUpdating = True
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

typos...


Sub ColumnsCompare2()
Dim n&, j&, lLastRow
Dim v1, v2, rngBig As Range

Const lStartRow& = 2

Application.ScreenUpdating = False
On Error GoTo ErrExit

lLastRow = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
v1 = Sheets("Sheet1").Range("C2:C" & lLastRow)

With Sheets("Sheet2")
lLastRow = .Cells(Rows.Count, "H").End(xlUp).Row
v2 = .Range("H2:H" & lLastRow)
For n = lStartRow To UBound(v1)
For j = lStartRow To UBound(v2)
If v1(n, 1) = v2(j, 1) Then
If rngBig Is Nothing Then
Set rngBig = .Range(.Cells(j, 1), .Cells(j, 26))
Else
Set rngBig = Union(rngBig, _
.Range(.Cells(j, 1), .Cells(j, 26)))
End If
End If
Next 'j
Next 'n
End With
If Not rngBig Is Nothing Then
Sheets("Sheet3").Range("A1").Resize(rngBig.Rows.Co unt, _
rngBig.Columns.Count).value = rngBig.value
Else
MsgBox "no matches found"
End If

ErrExit:
Set rngBig = Nothing
Application.ScreenUpdating = True
End Sub

I also meant to mention about empty cells will match so you may want to
check this with an 'And' operator on at least one of the arrays.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Howard,

Am Thu, 12 Feb 2015 09:53:34 +0100 schrieb Claus Busch:

you also could copy the range A2:Z & Lrow to sheet3 and delete the rows
that do not match:

there are some superfluous lines into the code.
Better try:

Sub ColumnsCompare3()

Dim i As Long, n As Long
Dim LRow1 As Long, LRow2 As Long
Dim MyArr As Variant

LRow1 = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
LRow2 = Sheets("Sheet2").Cells(Rows.Count, "H").End(xlUp).Row
MyArr = Sheets("Sheet2").Range("H2:H" & LRow2)

Application.ScreenUpdating = False

Sheets("Sheet2").Range("A2:Z" & LRow2).Copy
Sheets("Sheet3").Range("A1").PasteSpecial xlPasteValues

With WorksheetFunction
For i = LBound(MyArr) To UBound(MyArr)
If .CountIf(Sheets("Sheet1").Range("C:C"), MyArr(i, 1)) = 0 Then
n = .Match(MyArr(i, 1), Sheets("Sheet3").Range("H1:H" & LRow2), 0)
Sheets("Sheet3").Rows(n).Delete
End If
Next
End With

Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Sub ColumnsCompare3()

Dim i As Long, n As Long
Dim LRow1 As Long, LRow2 As Long
Dim MyArr As Variant

LRow1 = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
LRow2 = Sheets("Sheet2").Cells(Rows.Count, "H").End(xlUp).Row
MyArr = Sheets("Sheet2").Range("H2:H" & LRow2)

Application.ScreenUpdating = False

Sheets("Sheet2").Range("A2:Z" & LRow2).Copy
Sheets("Sheet3").Range("A1").PasteSpecial xlPasteValues

With WorksheetFunction
For i = LBound(MyArr) To UBound(MyArr)
If .CountIf(Sheets("Sheet1").Range("C:C"), MyArr(i, 1)) = 0 Then
n = .Match(MyArr(i, 1), Sheets("Sheet3").Range("H1:H" & LRow2), 0)
Sheets("Sheet3").Rows(n).Delete
End If
Next
End With

Application.ScreenUpdating = True
End Sub


Regards
Claus B.


Thanks guys, got lots of codes to test.

Claus, this ColumnsCompare3() code seems to do well, except it writes to A1 on sheet 3 each time.

Was looking for the equivalent of:

Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp)(2)

For each time the code is run. The next empty cell in column A for each run of the code.

Do you think the delete the non-match is ok on much larger columns , say 1500 to 3000 rows on sheet1 and sheet2?

Howard

On Thursday, February 12, 2015 at 1:10:03 AM UTC-8, GS wrote:
Optionally...

Sub ColumnsCompare2()
Dim n&, j&, lLastRow
Dim v1, v2, rngBig As Range

Const lStartRow& = 2

Application.ScreenUpdating = False
On Error GoTo ErrExit

lLastRow = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
MyArr1 = Sheets("Sheet1").Range("C2:C" & lLastRow)

With Sheets("Sheet2")
lLastRow = .Cells(Rows.Count, "H").End(xlUp).Row
MyArr2 = .Range("H2:H" & lLastRow)
For n = lStartRow To UBound(MyArr1)
For j = lStartRow To UBound(MyArr2)
If MyArr1(n, 1) = MyArr2(j, 1) Then
If rngBig Is Nothing Then
Set rngBig = .Range(.Cells(j, 1), .Cells(j, 26))
Else
Set rngBig = Union(rngBig, _
.Range(.Cells(j, 1), .Cells(j, 26)))
End If
End If
Next 'j
Next 'n
End With
If Not rngBig Is Nothing Then
Sheets("Sheet3").Range("A1").Resize(rngBig.Rows.Co unt, _
rngBig.Columns.Count).value = rngBig.value
Else
MsgBox "no matches found"
End If

ErrExit:
Set rngBig = Nothing
Application.ScreenUpdating = True
End Sub

--
Garry


Hi Garry, thanks for weighing in.

Had to Dim the two MyArr1 & MyArr2 and find that the code returns rows 33, 4 & 3 only. Which is strange since 33 is not a match and 3 and 4 are a match and there are several other rows that are a match which did not copy to sheet 3.

The code also writes to A1 each time it is run instead of to next empty cell I column A, sheet3.

The main reason I looked to arrays was my thought of dealing with a very long list on sheets 1 & 2, although my example is pretty small.

As you can see, I am still on the outside looking in when I comes to arrays.

Howard

Hi Howard,

Am Thu, 12 Feb 2015 02:05:14 -0800 (PST) schrieb L. Howard:

Claus, this ColumnsCompare3() code seems to do well, except it writes to A1 on sheet 3 each time.

try:

Sub ColumnsCompare3()

Dim i As Long, n As Long
Dim LRow As Long, LRow2 As Long
Dim MyArr As Variant

LRow2 = Sheets("Sheet2").Cells(Rows.Count, "H").End(xlUp).Row
MyArr = Sheets("Sheet2").Range("H2:H" & LRow2)

Application.ScreenUpdating = False

Sheets("Sheet2").Range("A2:Z" & LRow2).Copy
Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2) _
.PasteSpecial xlPasteValues

With WorksheetFunction
LRow = Sheets("Sheet3").Cells(Rows.Count, "H").End(xlUp).Row
For i = LBound(MyArr) To UBound(MyArr)
If .CountIf(Sheets("Sheet1").Range("C:C"), MyArr(i, 1)) = 0 Then
n = .Match(MyArr(i, 1), Sheets("Sheet3").Range("H1:H" & LRow), 0)
Sheets("Sheet3").Rows(n).Delete
End If
Next
End With

Application.ScreenUpdating = True
End Sub

Do you think the delete the non-match is ok on much larger columns , say 1500 to 3000 rows on sheet1 and sheet2?

Test it with larger columns. With less than 100 rows the code is faster
than the other suggestions.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Thu, 12 Feb 2015 02:05:14 -0800 (PST) schrieb L. Howard:

Do you think the delete the non-match is ok on much larger columns , say 1500 to 3000 rows on sheet1 and sheet2?

I have tested it with 4000+ rows. In this case the other macro with
rngBig is faster.
If you want the new run under the existing data then change the If
statement:
If Not rngBig Is Nothing Then
Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2) _
.Resize(rngBig.Rows.Count, rngBig.Columns.Count) _
.Value = rngBig.Value
Else
MsgBox "no matches found"
End If


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

On Thursday, February 12, 2015 at 1:10:03 AM UTC-8, GS wrote:
Optionally...

Sub ColumnsCompare2()
Dim n&, j&, lLastRow
Dim v1, v2, rngBig As Range

Const lStartRow& = 2

Application.ScreenUpdating = False
On Error GoTo ErrExit

lLastRow = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
MyArr1 = Sheets("Sheet1").Range("C2:C" & lLastRow)

With Sheets("Sheet2")
lLastRow = .Cells(Rows.Count, "H").End(xlUp).Row
MyArr2 = .Range("H2:H" & lLastRow)
For n = lStartRow To UBound(MyArr1)
For j = lStartRow To UBound(MyArr2)
If MyArr1(n, 1) = MyArr2(j, 1) Then
If rngBig Is Nothing Then
Set rngBig = .Range(.Cells(j, 1), .Cells(j, 26))
Else
Set rngBig = Union(rngBig, _
.Range(.Cells(j, 1), .Cells(j, 26)))
End If
End If
Next 'j
Next 'n
End With
If Not rngBig Is Nothing Then
Sheets("Sheet3").Range("A1").Resize(rngBig.Rows.Co unt, _
rngBig.Columns.Count).value = rngBig.value
Else
MsgBox "no matches found"
End If

ErrExit:
Set rngBig = Nothing
Application.ScreenUpdating = True
End Sub

--
Garry


Hi Garry, thanks for weighing in.

Had to Dim the two MyArr1 & MyArr2 and find that the code returns
rows 33, 4 & 3 only. Which is strange since 33 is not a match and 3
and 4 are a match and there are several other rows that are a match
which did not copy to sheet 3.

The code also writes to A1 each time it is run instead of to next
empty cell I column A, sheet3.

I normally use a position counter (lNextRow) for this once the 1st
empty row is found using End(xlUp), and increment it each time I write
a new row to the target sheet.

Optionally, if the output is an array then...

wksTarget.Cells(lNextRow, 1).Resize(Ubound(vData), UBound(vData, 2)

...to set height/width of the target area to the y/x size of the array.

The main reason I looked to arrays was my thought of dealing with a
very long list on sheets 1 & 2, although my example is pretty small.

As you can see, I am still on the outside looking in when I comes to
arrays.

You can't get your feet wet until you get in the water!<g Same goes
for learning to swim. Well, you're definitely in the water and so just
need to persist toward your goal!<g

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Claus,

The ColumnsCompareOne code will copy down to the first non-match on sheet1 column C and then disregards any other marches further down the list.


The ColumnsCompareTwo code works well, where the non-matches are removed from the data while on sheet3.

Is it much trouble to make ColumnsCompareOne work for all matches on sheet1?
Having both codes would be nice, if not too much trouble.

Thanks.
Howard

Sub ColumnsCompareOne()
'/ Copies to the first non-match only

Dim i As Long, ii As Long

Dim LRow1 As Long, LRow2 As Long

Dim MyArr1 As Variant
Dim MyArr2 As Variant

Dim rngBig As Range

LRow1 = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
MyArr1 = Sheets("Sheet1").Range("C2:C" & LRow1)
LRow2 = Sheets("Sheet2").Cells(Rows.Count, "H").End(xlUp).Row
MyArr2 = Sheets("Sheet2").Range("H2:H" & LRow2)

Application.ScreenUpdating = False

With Sheets("Sheet2")

For i = LBound(MyArr1) To UBound(MyArr1)
For ii = LBound(MyArr2) To UBound(MyArr2)
If MyArr1(i, 1) = MyArr2(ii, 1) Then


If rngBig Is Nothing Then

Set rngBig = .Range(.Cells(ii + 1, 1), .Cells(ii + 1, 26))
Else
Set rngBig = Union(rngBig, _
.Range(.Cells(ii + 1, 1), .Cells(ii + 1, 26)))
End If

End If
Next 'ii
Next 'i

End With


If Not rngBig Is Nothing Then

Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2) _
.Resize(rngBig.Rows.Count, rngBig.Columns.Count) _
.Value = rngBig.Value

Else
MsgBox "no matches found"
End If

Application.ScreenUpdating = True
End Sub


Sub ColumnsCompareTwo()
'/ By Claus @ MSPublic
'/ Works fine

Dim i As Long, n As Long

Dim LRow As Long, LRow2 As Long
Dim MyArr As Variant


LRow2 = Sheets("Sheet2").Cells(Rows.Count, "H").End(xlUp).Row
MyArr = Sheets("Sheet2").Range("H2:H" & LRow2)

Application.ScreenUpdating = False

Sheets("Sheet2").Range("A2:Z" & LRow2).Copy

Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2) _
.PasteSpecial xlPasteValues

With WorksheetFunction
LRow = Sheets("Sheet3").Cells(Rows.Count, "H").End(xlUp).Row

For i = LBound(MyArr) To UBound(MyArr)
If .CountIf(Sheets("Sheet1").Range("C:C"), MyArr(i, 1)) = 0 Then

n = .Match(MyArr(i, 1), Sheets("Sheet3").Range("H1:H" & LRow), 0)

Sheets("Sheet3").Rows(n).Delete
End If
Next
End With

End Sub

Hi Howard,

Am Thu, 12 Feb 2015 09:52:17 -0800 (PST) schrieb L. Howard:

The ColumnsCompareOne code will copy down to the first non-match on sheet1 column C and then disregards any other marches further down the list.

what do you mean that only the first match will be copied?
If a value is often in Sheet1 and only one time in Sheet2 should then
this one row be copied as often as the value occurs in Sheet1?
Can you send me an example with data and the expected output?


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Can you send me an example with data and the expected output?


Hi Claus,

Simple sample data. Sheet 3 is empty to start.

If you click button 1, see sheet three is 1 to 9 values only.

Click button 2 and desired results are posted on sheet 3.

And both codes stack the data properly on sheet 3.

https://www.dropbox.com/s/pdaeg3dl06...0Box.xlsm?dl=0

Howard

Hi Howard,

Am Thu, 12 Feb 2015 12:56:19 -0800 (PST) schrieb L. Howard:

If you click button 1, see sheet three is 1 to 9 values only.

Click button 2 and desired results are posted on sheet 3.

I changed the code to:

Sub ColumnsCompareOne()

Dim i As Long, ii As Long

Dim LRow1 As Long, LRow2 As Long

Dim MyArr1 As Variant
Dim MyArr2 As Variant
Dim varData As Variant

Dim rngBig As Range

LRow1 = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
MyArr1 = Sheets("Sheet1").Range("C2:C" & LRow1)
LRow2 = Sheets("Sheet2").Cells(Rows.Count, "H").End(xlUp).Row
MyArr2 = Sheets("Sheet2").Range("H2:H" & LRow2)
varData = Sheets("Sheet2").Range("A2:Z" & LRow2)

Application.ScreenUpdating = False

With Sheets("Sheet2")

For i = LBound(MyArr1) To UBound(MyArr1)
For ii = LBound(MyArr2) To UBound(MyArr2)
If MyArr1(i, 1) = MyArr2(ii, 1) Then
Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2) _
.Resize(, 26) = Application.Index(varData, ii, 0)
Exit For
End If
Next 'ii
Next 'i

End With

Application.ScreenUpdating = True
End Sub

Or look he
https://onedrive.live.com/?cid=9378A...121822A3%21326
for "Book3"


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

I changed the code to:



Hi Claus, that is great.

I like the code no. 1 because I am able to easily read it, having written almost all of it.

Both will make a good reference for me I believe and should serve the OP quite well.

Thanks for the great help and thanks to Garry also.

Howard

A further question.

There is some color formatting on sheet 2 that needs to go to sheet 3 when the code is run.

I suppose it will take something like this...

..PasteSpecial Paste:=xlPasteFormats

but I can't figure where to add it in. Tried a place or two but errors out or won't compile.

So basically want to keep the formatting for whatever was on sheet2 that gets moved to sheet 3.

The Sub ColumnsCompareTwo copies entire sheet 2 to sheet 3 and then eliminates much of it where does not match etc. That seems to me to be an even bigger challenge.

However, I cannot figure how to carry formatting to sheet 3.

I am inquiring as to whether the formatting is conditional formatting or on sheet fill. I suspect that will make a difference in the coding.

Howard

A further question.

There is some color formatting on sheet 2 that needs to go to sheet 3
when the code is run.

I suppose it will take something like this...

.PasteSpecial Paste:=xlPasteFormats

but I can't figure where to add it in. Tried a place or two but
errors out or won't compile.

So basically want to keep the formatting for whatever was on sheet2
that gets moved to sheet 3.

The Sub ColumnsCompareTwo copies entire sheet 2 to sheet 3 and then
eliminates much of it where does not match etc. That seems to me to
be an even bigger challenge.

However, I cannot figure how to carry formatting to sheet 3.

I am inquiring as to whether the formatting is conditional formatting
or on sheet fill. I suspect that will make a difference in the
coding.

Howard

Perhaps...
If you assign the range to a range object...

Set rngSource = Sheets("Sheet2").Range("A2:Z" & LRow2)

...then you can just copy the row with all formatting...

If MyArr1(i, 1) = MyArr2(ii, 1) Then
Application.Index(rngSource, ii, 0).Copy _
Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2) .Resize(, 26)
Exit For
End If

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

A further question.

There is some color formatting on sheet 2 that needs to go to sheet
3 when the code is run.

I suppose it will take something like this...

.PasteSpecial Paste:=xlPasteFormats

but I can't figure where to add it in. Tried a place or two but
errors out or won't compile.

So basically want to keep the formatting for whatever was on sheet2
that gets moved to sheet 3.

The Sub ColumnsCompareTwo copies entire sheet 2 to sheet 3 and then
eliminates much of it where does not match etc. That seems to me
to be an even bigger challenge.

However, I cannot figure how to carry formatting to sheet 3.

I am inquiring as to whether the formatting is conditional
formatting or on sheet fill. I suspect that will make a difference
in the coding.

Howard

Perhaps...
If you assign the range to a range object...

Set rngSource = Sheets("Sheet2").Range("A2:Z" & LRow2)

..then you can just copy the row with all formatting...

If MyArr1(i, 1) = MyArr2(ii, 1) Then
Application.Index(rngSource, ii, 0).Copy _
Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2)
Exit For
End If

If the rows on the target sheet are empty then you don't need to
..Resize()

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

I screwed this up some how, does not error nor does not return anything.

I'm testing on this workbook, if this link does not work there is a live one on Claus' last post for a test sheet of mine.

https://onedrive.live.com/?cid=9378A...121822A3%21326

Before I made changes you suggested, I ran this code on a OP linked workbook and it returned a single entry, a correct one.

The two codes I have from Claus both return two entries.

Can you see where I got it wrong here?

Howard

Sub ColumnsC_Garry()
Dim n&, j&, lLastRow
Dim v1, v2, rngBig As Range, rngSource As Range
Dim i As Long, ii As Long

Dim MyArr1 As Variant
Dim MyArr2 As Variant

Const lStartRow& = 2

Application.ScreenUpdating = False
On Error GoTo ErrExit

lLastRow = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
MyArr1 = Sheets("Sheet1").Range("C2:C" & lLastRow)

With Sheets("Sheet2")
lLastRow = .Cells(Rows.Count, "H").End(xlUp).Row
MyArr2 = .Range("H2:H" & lLastRow)
For n = lStartRow To UBound(MyArr1)
For j = lStartRow To UBound(MyArr2)
If MyArr1(n, 1) = MyArr2(j, 1) Then

If rngBig Is Nothing Then

Set rngBig = .Range(.Cells(j, 1), .Cells(j, 26))

Else
Set rngBig = Union(rngBig, _
.Range(.Cells(j, 1), .Cells(j, 26)))
End If
End If
Next 'j
Next 'n

End With

If Not rngBig Is Nothing Then

If MyArr1(i, 1) = MyArr2(ii, 1) Then
Application.Index(rngSource, ii, 0).Copy _
Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2)
Else
MsgBox "no matches found"
End If
End If

ErrExit:
Set rngBig = Nothing

Application.ScreenUpdating = True
End Sub

In the line before your loops, replace MyArr2 with a ref to rngSource
so you're working directly on the range itself rather than its data
array...

Set rngSource = Sheets("Sheet2").Range("H2:H" & lLastRow)

...then in your loops, replace UBound(MyArr2) with rngSource.Rows.Count.
Lose the rngBig and Union code and just copy the rngSource row to
Sheet3 right in the loop while matches are found. This approach may be
a tad slower but it saves a 2nd step to copy the formatting. IOW, you
insert each row when matching, NOT build an array because arrays only
handle values NOT formatting.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

In the line before your loops, replace MyArr2 with a ref to rngSource
so you're working directly on the range itself rather than its data
array...

Set rngSource = Sheets("Sheet2").Range("H2:H" & lLastRow)

..then in your loops, replace UBound(MyArr2) with
rngSource.Rows.Count. Lose the rngBig and Union code and just copy
the rngSource row to Sheet3 right in the loop while matches are
found. This approach may be a tad slower but it saves a 2nd step to
copy the formatting. IOW, you insert each row when matching, NOT
build an array because arrays only handle values NOT formatting.

I forgot to mention your ref to rngBig under the ErrExit label should
now ref rngSource.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Garry,

Sure seems to me it should work, but, no errors and no results.
Code acts like it runs, but returns nothing.

Howard

Sub ColumnsC_Garry()

Dim n&, j&, lLastRow
Dim rngSource As Range
Dim i As Long, ii As Long
Dim MyArr1 As Variant

Const lStartRow& = 2

Application.ScreenUpdating = False
On Error GoTo ErrExit

lLastRow = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
MyArr1 = Sheets("Sheet1").Range("C2:C" & lLastRow)

With Sheets("Sheet2")

lLastRow = .Cells(Rows.Count, "H").End(xlUp).Row
Set rngSource = Sheets("Sheet2").Range("H2:H" & lLastRow)

For n = lStartRow To UBound(MyArr1)
For j = lStartRow To lLastRow

If MyArr1(n, 1) = rngSource.Rows.Count Then

If rngSource Is Nothing Then
Set rngSource = .Range(.Cells(j, 1), .Cells(j, 26))

If MyArr1(i, 1) = rngSource Then
Application.Index(rngSource, ii, 0).Copy _
Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2)

Else
MsgBox "no matches found"

End If 'Myrr1(i

End If 'rngSou

End If 'MyArr1(n

Next 'j

Next 'n

End With

ErrExit:
Set rngSource = Nothing

Application.ScreenUpdating = True
End Sub

On Friday, February 13, 2015 at 9:48:52 PM UTC-8, L. Howard wrote:
Hi Garry,


This does copy the first and only the first match and the formatting.

Can't make it loop, just get the first row.

Howard

Sub ColumnsC_Garry()

Dim n&, j&, lLastRow
Dim rngSource As Range

Dim MyArr1 As Variant

Const lStartRow& = 2

Application.ScreenUpdating = False
On Error GoTo ErrExit

lLastRow = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
MyArr1 = Sheets("Sheet1").Range("C2:C" & lLastRow)

With Sheets("Sheet2")

lLastRow = .Cells(Rows.Count, "H").End(xlUp).Row
Set rngSource = Sheets("Sheet2").Range("H2:H" & lLastRow)

For n = lStartRow To UBound(MyArr1)
For j = lStartRow To lLastRow

If MyArr1(n, 1) = rngSource(j) Then '.Rows.Count Then

' If rngSource Is Nothing Then
Set rngSource = .Range(.Cells(j, 1), .Cells(j, 26))

' If MyArr1(n, 1) = rngSource(j) Then
rngSource.Copy _
Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2)

' Else
' MsgBox "no matches found"

End If 'Myrr1(n

' End If 'rngSou

' End If 'MyArr1(n

Next 'j

Next 'n

End With

ErrExit:
Set rngSource = Nothing

Application.ScreenUpdating = True
End Sub

Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2)

The line above isn't a valid row ref when the target sheet is empty
because the last part refs an array index. No data means no array and
so this line returns 0 on an empty sheet.

In the file you linked to add a new button on sheet1 that uses this
sub...

Sub CompareCols()
Dim n&, j&, lNextRow&, lLastRow&
Dim rngSource As Range, vCriteria

'Get next empty row on target sheet
'If the sheet has no data then returns row2
lNextRow = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row + 1

'Load the search criteria into an array
With Sheets("Sheet1")
lLastRow = .Cells(Rows.Count, "C").End(xlUp).Row
'(include the header row for correct row index refs)
vCriteria = .Range("C1:C" & lLastRow)
End With 'Sheets("Sheet1")

On Error GoTo ErrExit
Application.ScreenUpdating = False
With Sheets("Sheet2")
'Get a fully qualified ref to the source data range
lLastRow = .Cells(Rows.Count, "H").End(xlUp).Row
'(include the header row for correct row index refs)
Set rngSource = .Range("A1:Z" & lLastRow)

'Search source data for criteria matches
For n = 2 To UBound(vCriteria)
For j = 2 To rngSource.Rows.Count
If vCriteria(n, 1) = rngSource.Cells(j, "H") Then
Application.Index(rngSource, j, 0).Copy _
Sheets("Sheet3").Cells(lNextRow, 1)
lNextRow = lNextRow + 1
Exit For '//find 1 match only per criteria
End If
Next 'j
Next 'n
End With 'Sheets("Sheet2")

ErrExit:
Set rngSource = Nothing
With Application
.CutCopyMode = False: .ScreenUpdating = True
End With
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2)

The line above isn't a valid row ref when the target sheet is empty
because the last part refs an array index. No data means no array and
so this line returns 0 on an empty sheet.

In the file you linked to add a new button on sheet1 that uses this
sub...

Sub CompareCols()
Dim n&, j&, lNextRow&, lLastRow&
Dim rngSource As Range, vCriteria

'Get next empty row on target sheet
'If the sheet has no data then returns row2
lNextRow = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row + 1

'Load the search criteria into an array
With Sheets("Sheet1")
lLastRow = .Cells(Rows.Count, "C").End(xlUp).Row
'(include the header row for correct row index refs)
vCriteria = .Range("C1:C" & lLastRow)
End With 'Sheets("Sheet1")

On Error GoTo ErrExit
Application.ScreenUpdating = False
With Sheets("Sheet2")
'Get a fully qualified ref to the source data range
lLastRow = .Cells(Rows.Count, "H").End(xlUp).Row
'(include the header row for correct row index refs)
Set rngSource = .Range("A1:Z" & lLastRow)

'Add headers if target sheet is empty
Application.Index(rngSource, 1, 0).Copy Sheets("Sheet3").Cells(1)

'Search source data for criteria matches
For n = 2 To UBound(vCriteria)
For j = 2 To rngSource.Rows.Count
If vCriteria(n, 1) = rngSource.Cells(j, "H") Then
Application.Index(rngSource, j, 0).Copy _
Sheets("Sheet3").Cells(lNextRow, 1)
lNextRow = lNextRow + 1
Exit For '//find 1 match only per criteria
End If
Next 'j
Next 'n
End With 'Sheets("Sheet2")

ErrExit:
Set rngSource = Nothing
With Application
.CutCopyMode = False: .ScreenUpdating = True
End With
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Howard,

Am Fri, 13 Feb 2015 22:32:08 -0800 (PST) schrieb L. Howard:

Can't make it loop, just get the first row.

modify your macro "CompareOne":

Sub ColumnsCompareOne()

Dim i As Long, ii As Long
Dim LRow1 As Long, LRow2 As Long
Dim MyArr1 As Variant
Dim varData As Variant

LRow1 = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
MyArr1 = Sheets("Sheet1").Range("C2:C" & LRow1)
LRow2 = Sheets("Sheet2").Cells(Rows.Count, "H").End(xlUp).Row
varData = Sheets("Sheet2").Range("A2:Z" & LRow2)

Application.ScreenUpdating = False

With Sheets("Sheet2")

For i = LBound(MyArr1) To UBound(MyArr1)
For ii = LBound(varData) To UBound(varData)
If MyArr1(i, 1) = varData(ii, 8) Then
Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2) _
.Resize(, 26) = Application.Index(varData, ii, 0)
.Rows(ii + 1).Copy
Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp) _
.PasteSpecial xlPasteFormats
Exit For
End If
Next 'ii
Next 'i

End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Or look again in OneDrive for Book3


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

I added some formatting to Sheet2.colA, and inserted headers in row1
with row CF.

Have a look at "Book3_v2.xlsm" here...

https://app.box.com/s/23yqum8auvzx17h04u4f

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

On Saturday, February 14, 2015 at 1:43:01 AM UTC-8, GS wrote:
I added some formatting to Sheet2.colA, and inserted headers in row1
with row CF.

Have a look at "Book3_v2.xlsm" here...

https://app.box.com/s/23yqum8auvzx17h04u4f

--
Garry


Okay, will do.

Appreciate the code, works well and packs the color format as advertised!
(And date formats)

Tnx,

Howard

On Saturday, February 14, 2015 at 2:03:31 AM UTC-8, L. Howard wrote:
On Saturday, February 14, 2015 at 1:43:01 AM UTC-8, GS wrote:
I added some formatting to Sheet2.colA, and inserted headers in row1
with row CF.

Have a look at "Book3_v2.xlsm" here...

https://app.box.com/s/23yqum8auvzx17h04u4f

--
Garry


Okay, will do.

Appreciate the code, works well and packs the color format as advertised!
(And date formats)

Tnx,

Howard

Garry, the headers are indeed a nice touch.

Probably will really be useful given that there are 26 columns of data going to the destination sheet.

Thanks.

Howard

Or look again in OneDrive for Book3


Regards
Claus B.

Hi Claus,

Another winner. Does great. Colors and dates are taken care of.

Thanks again, appreciate it.

Howard

On Saturday, February 14, 2015 at 2:03:31 AM UTC-8, L. Howard wrote:
On Saturday, February 14, 2015 at 1:43:01 AM UTC-8, GS wrote:
I added some formatting to Sheet2.colA, and inserted headers in
row1 with row CF.

Have a look at "Book3_v2.xlsm" here...

https://app.box.com/s/23yqum8auvzx17h04u4f

--
Garry


Okay, will do.

Appreciate the code, works well and packs the color format as
advertised! (And date formats)

Tnx,

Howard

Garry, the headers are indeed a nice touch.

Probably will really be useful given that there are 26 columns of
data going to the destination sheet.

Thanks.

Howard

I like to include headers in the data container because they reflect
current fields info for the data. Even though the comment states "if",
the headers are copied anyway because they go with the data being
copied. Some tweaking is required to set copy conditions if existing
headers are not to be updated/changed!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Howard, hi Garry,

Am Sat, 14 Feb 2015 05:49:24 -0500 schrieb GS:

I like to include headers in the data container because they reflect
current fields info for the data.

I like headers also. And some things like Autofilter, Advanced filter or
Pivot table demand headers.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional