Dynamic Array not response

[Len]

Hi,

After several attempts to run the codes below, it fails to copy each
row of data in column A of sheet1 from workbookX instead it copied the
last row of data only ( ie only response to last row in this array
"rngtrg(m)" )
In fact, my intended codes is to copy each row of data in column A of
sheet1 from workbookX and place it in the array, then use each copied
row from the array to search the text string from column D in sheet2
of another workbook(Y),
If found, it will copy each matched row of data back to column A after
the last used cells, of sheet1 in workbookX


Extract of codes

Dim m%, rngtrg$(), klstrw As Long
Dim k As Integer
klstrw = Cells(Rows.Count, "A").End(xlUp).Row

For k = 1 To klstrw
m = m + 1
ReDim Preserve rngtrg(1 To m)
rngtrg(m) = Workbooks("X").Worksheets("Sheet1").Cells(k, 1)
Next k

Windows("WorkbookY.xls").Activate
With Worksheets("Sheet2")
Dim iLastRow As Long, i As Integer
Dim iNextRow As Long
iLastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
For i = 1 To iLastRow
If .Cells(i, "D").Value = rngtrg(m) Then
iNextRow = iNextRow + 1
..Rows(i).Copy Workbooks("X").Worksheets("sheet1").Cells(iNextRow,
"A").Offset(klstrw + 2, 0)
End If
Next i
End With


Any help on this problem will be much appreciated

Thanks in advance

Regards
Len

 

[JLGWhiz]

I think you need to move this to inside your for loop.

klstrw = Cells(Rows.Count, "A").End(xlUp).Row


You would probably be better off just using an offset without reference to
the klstrw variable since the klstrw variable is in one sheet and the
destination range is in another.

 

[Per Jessen]

Hi

Your code does not loop over the values in the array, and you have a
fixed destination row in your copy statement:

In the statement below, m is a static value while comparing to values
in Sheet2.

If .Cells(i, "D").Value = rngtrg(m) Then

Look at this:

Sub bbb()
Dim TargetRng As Range
Dim SearchRng As Range
Dim CopyToCell As Range

With Workbooks("X").Worksheets("Sheet1")
Set TargetRng = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
Set CopyToCell = .Range("A" & Rows.Count).End(xlUp).Offset(2, 0)
End With
With Workbooks("WorkbookY.xls").Worksheets("Sheet2")
Set SearchRng = .Range("D1", Range("D" & Rows.Count).End(xlUp))
End With
For Each cell In TargetRng.Cells
For Each c In SearchRng.Cells
If cell.Value = c.Value Then
c.EntireRow.Copy CopyTo
Set CopyToCell = CopyToCell.Offset(1, 0)
End If
Next
Next
End Sub

Hopes this helps.
...
Per

 

[Len]

Hi Per,

Thanks for your kind response and your suggestion codes
It works perfectly !


Hi JL,

Thanks for your kind advise and I was a bit confused on how to use
offset to replace klstrw variable in this situation
It would be great if you could share your codes to use offset method
to make the above codes works

Thanks again for all your helps

Regards
Len

 

[JLGWhiz]

Per has already solved the overall problem, but here is what I am referring
to:

klstrw = Cells(Rows.Count, "A").End(xlUp).Row

This line of code refers only to the ActiveSheet so that when you use it
here:

..Rows(i).Copy Workbooks("X").Worksheets("sheet1").Cells(iNextRow,
"A").Offset(klstrw + 2, 0)

The Offset is based on a fixed value from the ActiveSheet, so you could just
as well have used a fixed integer value, since "klstrw" has no relevance to
the Workbooks("X").Worksheets("sheet1").

 

[Len]

Hi JL,

Thanks for your reply, I got your tips now on klstrw

In this case, can I use back my codes and rectify it, how would you
advise and share your rectified codes as I do not have any ideas to
rectify it
( ie to share the next alternative vba codes apart from Per's codes )


Thanks again for your great helps

Regards
Len