View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Per Jessen[_2_] Per Jessen[_2_] is offline
external usenet poster
 
Posts: 703
Default Dynamic Array not response

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

On 5 Feb., 17:12, Len wrote:
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