Array to read data from one sheet and write to another if it meets criteria

[RudyShoe]

Newb to VBA and need some assistance. I have data in one worksheet that
I need to write to another if it meets certain criteria. What I have
runs but it places the data in the matching cell. For example cell A35
meets criteria so it, along with data from cell BD35 and cell BQ35 are
placed in cell A35, B35, C35 in the new sheet but I'd like it to be
place in the next empty cell.

Here's what I have....

Dim i As Integer
Dim intRowCount As Integer
intRowCount = Range("'qry CR data
dump.xls'!A2").CurrentRegion.Rows.Count
For i = 2 To intRowCount
If Left(Workbooks("data.xls").Worksheets("dump").Cells(i,
"A").Value, 3) = "CR-" Then
Cells(i, "A").Offset(4, 0).Value =
Right(Workbooks("data.xls").Worksheets("dump").Cells(i, "A").Value, 4)
Cells(i, "B").Offset(4, 0).Value =
Right(Workbooks("data.xls").Worksheets("dump").Cells(i, "BD").Value, 4)
Cells(i, "C").Offset(4, 0).Value =
Workbooks("data.xls").Worksheets("dump").Cells(i, "BQ").Value
ActiveCell.Offset(1, 0).Select
Else: End If
Next i


Thanks in advance!

 

[NickHK]

You mean something like this.
Wasn't sure of the source of the data, as you seem to have 2; "qry CR data
dump.xls" and "data.xls".

Private Sub CommandButton2_Click()
Dim SourceWB As Workbook
Dim i As Integer
Dim intRowCount As Integer

Set SourceWB = Workbooks("data.xls")
intRowCount = 4 'start value ? As you had Cells(i, "A").Offset(4, 0)
With SourceWB.Worksheets("dump")
For i = 2 To .Range("A2").CurrentRegion.Rows.Count
If Left(.Cells(i, "A").Value, 3) = "CR-" Then
intRowCount = intRowCount + 1
Cells(intRowCount, "A").Value = Right(.Cells(i, "A").Value, 4)
Cells(intRowCount, "B").Value = Right(.Cells(i, "BD").Value, 4)
Cells(intRowCount, "C").Value = .Cells(i, "BQ").Value
End If
Next i
End With
End Sub

NickHK

 

[RudyShoe]

Perfect, that did the trick! Many thanks! Sorry for the confusion on
the source data, my error.

One other question- can this be written so that code executes faster?