My Never ending ARRAY code problems

  • Thread starter Thread starter L. Howard
  • Start date Start date
L

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.

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.
Click to expand...

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.Count, _
rngBig.Columns.Count).Value = rngBig.Value

Application.ScreenUpdating = True
End Sub


Regards
Claus B.
 
Hi Howard,

Am Thu, 12 Feb 2015 08:12:12 +0100 schrieb Claus Busch:
Sheets("Sheet3").Range("A1").Resize(rngBig.Rows.Count, _
rngBig.Columns.Count).Value = rngBig.Value
Click to expand...

change this output command to:

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


Regards
Claus B.
 
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
Click to expand...
^^^^^
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.Count, _
rngBig.Columns.Count).Value = rngBig.Value
Else
MsgBox "no matches found"
End If

Application.ScreenUpdating = True
End Sub


Regards
Claus B.
 
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).
Click to expand...

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.
 
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.Count, _
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.Count, _
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:
Click to expand...

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.
 
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.
Click to expand...


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
 
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.Count, _
rngBig.Columns.Count).value = rngBig.value
Else
MsgBox "no matches found"
End If

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

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.
Click to expand...

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?
Click to expand...

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


Regards
Claus B.
 
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?
Click to expand...

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.
 
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.
Click to expand...

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.
Click to expand...

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.
Click to expand...

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.
 
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.
Click to expand...

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 here:
https://onedrive.live.com/?cid=9378...#cid=9378AAB6121822A3&id=9378AAB6121822A3!326
for "Book3"


Regards
Claus B.
 
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
 
Back
Top