VBA Find-Copy and Loop Trouble

[antora]

hi guys need your help.

I have a problem in using the 'find-copy and loop' method,

here's my data:

	A	B	C	D	E	F	G
1	Name 1	A1	OK	A2	OK	-	-
2	Name 2	B1	OK	-	-	-	-
3	Name 3	C1	OK	C2	OK	C3	OK
4	Name 4	D1	OK	-	-	D3	OK
5	Name 5	E1	OK	-	-	-	-
6	....

<tbody>
</tbody>

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. whereas, based on the above data should be there around 9 results but that appears there's only 8 results. what is lacking or wrong of my code.?

thanks before.

 

[p45cal]

try:

Sub Copas()
Dim DestSheet As Worksheet
Set DestSheet = Worksheets("Sheet2")

Dim sColm 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 sColm = 2 To Cells(X, Columns.Count).End(xlToLeft).Column
        If Cells(X, sColm) Like "*OK*" Then
            sCount = sCount + 1
            dRow = dRow + 1
            Cells(X, 1).Copy Destination:=DestSheet.Cells(dRow, "A")
            Cells(X, sColm).Copy Destination:=DestSheet.Cells(dRow, "B")
            Cells(X, sColm - 1).Copy Destination:=DestSheet.Cells(dRow, "C")
        End If
    Next sColm
    X = X + 1
Loop
End Sub

(I changed sRow to sColm as it seemed odd to name a variable with the word row in it when it refers to a column!)

 

[antora]

try:

Sub Copas()
Dim DestSheet As Worksheet
Set DestSheet = Worksheets("Sheet2")

Dim sColm 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 sColm = 2 To Cells(X, Columns.Count).End(xlToLeft).Column
        If Cells(X, sColm) Like "*OK*" Then
            sCount = sCount + 1
            dRow = dRow + 1
            Cells(X, 1).Copy Destination:=DestSheet.Cells(dRow, "A")
            Cells(X, sColm).Copy Destination:=DestSheet.Cells(dRow, "B")
            Cells(X, sColm - 1).Copy Destination:=DestSheet.Cells(dRow, "C")
        End If
    Next sColm
    X = X + 1
Loop
End Sub

(I changed sRow to sColm as it seemed odd to name a variable with the word row in it when it refers to a column!)

Thanks P45cal... it works
so., what if the search is based on rows. which lines should be replaced?

 

[p45cal]

so., what if the search is based on rows. which lines should be replaced?

I don't really understand the question. Currently there's a nested loop:

Do Until Cells(X, 1) = "" 'X is used to define the row number and is incremented each time (the outside loop) 
  For sColm = 2 To Cells(X, Columns.Count).End(xlToLeft).Column 'scolm is used to define the column number and is incremented each time (the inner loop)
    'do stuff here with Cells(X,sColm)  'syntax is: Cells(row number, column number)
  Next sColm   
  X = X + 1 
Loop

The comments in the above snippet show that both rows and colums are used.
I suppose you could invert the loops and put the inside one on the outside:

For sColm = 2 To Cells(X, Columns.Count).End(xlToLeft).Column
   Do Until Cells(X, 1) = ""
     'do stuff here with Cells(X,sColm)     
     X = X + 1   
   Loop
Next sColm

Is that what you meant?