Macro Question

[David]

Hey All,

using the following vba code, i am trying to copy all the rows that have the
word "OK" on column A, example

i have data on row 1 to 20 and the following rows have "OK" on column A

rwo 2, row 5 and row 6, i want the macro to search for the word "OK" on
column A and copy the entire line inn sheet on the next empty row.

my current macro find the word "OK" however keeps copying the first line for
the number of "OK" it fined, in my example it will copy row 2 data three
times on sheet2.

Sub A()
Dim lastrow As Long
Dim r As Long
lastrow = Range("A" & Rows.Count).End(xlUp).row
For r = lastrow To 1 Step -1
If InStr(1, Cells(r, 1).Value, "OK") > 0 Then
Cells(r, 1).EntireRow.Select
Selection.Copy
Sheets("Sheet2").Select
Range("a1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("sheet1").Select
End If
Next
End Sub


Appreciate all the help

thanks
david

 

[Mike H]

David,

Try it like this. Note that also I've qualified the ranges using SrcSht and
DstSht. Your code told us the data are going to sheet 2 and I've assumed
sheet1 as the source sheet so change to suit.

I also added VbTextCompare to your Instr line which stops it being case
sensitive, simply take this out if you want it to remain case sensitive


Sub A()
Dim lastrow As Long
Dim CopyRange As Range
Dim r As Long
Set SrcSht = Sheets("Sheet1")
Set DstSht = Sheets("Sheet2")
With SrcSht
lastrow = .Cells(Cells.Rows.Count, "A").End(xlUp).Row
For r = 1 To lastrow
If InStr(1, .Cells(r, 1).Value, "OK", vbTextCompare) > 0 Then
If CopyRange Is Nothing Then
Set CopyRange = .Rows(r).EntireRow
Else
Set CopyRange = Union(CopyRange, .Rows(r).EntireRow)
End If

End If
Next
End With
If Not CopyRange Is Nothing Then
lastrow = DstSht.Cells(Cells.Rows.Count, "A").End(xlUp).Row
CopyRange.Copy Destination:=DstSht.Range("A" & lastrow + 1)
End If
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[David]

Hi Mike,

you are great, it works perfectly. thank you

 

[David]

Hi Mike,

i running into a little problem, macro works fine for about 20 lines, then i
get an error message "Run time error '1004' and copy method of range class
failed"

I appreciate your help.
thanks