VBA Find Copy Loop Trouble

[antora]

Hi excel master...
I have a problem in using the 'find-copy and loop' method,

here's my data:

   A  B     C  D  E  F  G  H
1  1  Name1 A1 OK A2 OK -  -
2  2  Name2 B1 OK -  -  -  -
3  3  Name3 C1 OK C2 OK C3 OK
4  4  Name4 D1 OK -  -  D3 OK
5  5  Name5 E1 OK
....

and this is the code I used:

Sub Copas()
  Dim DestSheet        As Worksheet
  Set DestSheet = Worksheets("Sheet2")
  
  Dim sRow       As Long
  Dim dRow       As Long
  Dim sCount     As Long
  Dim X As Long
  sCount = 0
  dRow = 1

X = 1
Do Until Cells(X, 1) = ""

  For sRow = Cells(X, 1) To Cells(X, 1000).End(xlToRight).Column
     If Cells(X, sRow) Like "*OK*" Then
        sCount = sCount + 1
        dRow = dRow + 1
        Cells(X, 1).Copy Destination:=DestSheet.Cells(dRow, "A")
        Cells(X, sRow).Copy Destination:=DestSheet.Cells(dRow, "B")
        Cells(X, sRow - 1).Copy Destination:=DestSheet.Cells(dRow, "C")
     End If
Next sRow
  
X = X + 1
Loop
End Sub

what happens is:
The code does not copy all the results that I found, but based on the above data should be there around 9 results but that happens there's only 8 results.

please help

[Andy Pope]

you inner loop is checking the following columns

sRow loop X= 1 From 1 To 16384
sRow loop X= 2 From 2 To 16384
sRow loop X= 3 From 3 To 16384
sRow loop X= 4 From 4 To 16384
sRow loop X= 5 From 5 To 16384

so at row 5 the testing starts in column E not A because the For loop is using the contents of the cell not the column position.

try this mod

For sRow = Cells(X, 1).column To Cells(X, 1000).End(xlToRight).Column

[AB33]

This gives you 9 result

Sub findvba()
 
 Dim x As Variant, i As Long, j As Long, n As Long, y
 
 With Worksheets("Sheet1")
    x = .Range("a2").CurrentRegion
 End With
 
 ReDim y(1 To UBound(x, 2) * UBound(x), 1 To 3)
 
 For i = 1 To UBound(x, 1)
        For j = 1 To UBound(x, 2)
           If x(i, j) Like "*OK*" Then
              n = n + 1
             y(n, 1) = x(i, 1)
             y(n, 2) = x(i, j)
             y(n, 3) = x(i, j - 1)
           End If
        Next
 Next
        
 With Worksheets("Sheet2")
    .Cells(2, 1).Resize(n, UBound(y, 2)) = y
    MsgBox n & " OK rows copied", vbInformation, "Transfer Done"
 End With
End Sub

[watersev]

hi antora, change this:

For sRow = Cells(X, 1) To Cells(X, 1000).End(xlToRight).Column

to

For sRow = 1 To ActiveSheet.UsedRange.Columns.Count

[antora]

hi antora, change this:

For sRow = Cells(X, 1) To Cells(X, 1000).End(xlToRight).Column

to

For sRow = 1 To ActiveSheet.UsedRange.Columns.Count

amazing... it works.
so do you have any idea if the searching based on the rows
eg. I want to find a value 'Name2', and the results I want based on the sample above is: OK D1, D3 OK.
?

[watersev]

hi there, can you explain what you mean? I'm not sure I do understand completely your question