Tweak some code

[RJG]

I found the following code on this board. it searches for a word in a
set column on each worksheet and then copies each row to a new
location. Could anybody suggest how to make the following changes
please.

I need to change two minor items in the code;-
Firstly it starts to outputs to sheet3 A2 and i would like it to start
to output from C17.
Secondly each time the macro is run it adds to the bottom of the
previous run, befor it starts i would like it to delete anything on
sheet3 between C17 and C37.

I would also like to thank the original authorfor a great piece of
code.

Private Sub CommandButton1_Click()
Dim sAdd As String, v As Variant
Dim sh As Worksheet, rng As Range
Dim rng1 As Range, i As Long
v = Array("Sheet1", "Sheet2")
For i = LBound(v) To UBound(v)
Set sh = Worksheets(v(i))
Set rng = sh.Columns(3)
Set rng1 = rng.Find(ComboBox1)
If Not rng1 Is Nothing Then
sAdd = rng1.Address
Do
rng1.EntireRow.Copy Destination:= _
Worksheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2)
Set rng1 = rng.FindNext(rng1)
Loop While rng1.Address <> sAdd
End If
Next


End Sub

 

[Luke M]

You can't copy an entire row, and then have it start in column C! Do you want
columns A:IT copied, or C:IV?

 

[Luke M]

To just copy A:IT of sheet1 over to sheet 3, starting at row 17, and always
clear C17:C37

Private Sub CommandButton1_Click()
Dim sAdd As String, v As Variant
Dim sh As Worksheet, rng As Range
Dim rng1 As Range, i As Long
v = Array("Sheet1", "Sheet2")
For i = LBound(v) To UBound(v)
Set sh = Worksheets(v(i))
Set rng = sh.Columns(3)
Set rng1 = rng.Find("bob") 'ComboBox1)
If Not rng1 Is Nothing Then
sAdd = rng1.Address
xRow = rng1.Row
Worksheets("Sheet3").Range("C17:C37").ClearContents

i = 17
Do
Worksheets("Sheet1").Range("A" & xRow & ":IT" & xRow). _
Copy Destination:=Worksheets("Sheet3").Cells(i, 3)
Set rng1 = rng.FindNext(rng1)
xRow = rng1.Row
i = i + 1
Loop While rng1.Address <> sAdd
End If
Next


End Sub

 

[Box666]

To just copy A:IT of sheet1 over to sheet 3, starting at row 17, and always
clear C17:C37

Private Sub CommandButton1_Click()
Dim sAdd As String, v As Variant
Dim sh As Worksheet, rng As Range
Dim rng1 As Range, i As Long
v = Array("Sheet1", "Sheet2")
For i = LBound(v) To UBound(v)
  Set sh = Worksheets(v(i))
  Set rng = sh.Columns(3)
  Set rng1 = rng.Find("bob") 'ComboBox1)
  If Not rng1 Is Nothing Then
    sAdd = rng1.Address
    xRow = rng1.Row
    Worksheets("Sheet3").Range("C17:C37").ClearContents

    i = 17
   Do
     Worksheets("Sheet1").Range("A" & xRow & ":IT" & xRow). _
     Copy Destination:=Worksheets("Sheet3").Cells(i, 3)
     Set rng1 = rng.FindNext(rng1)
     xRow = rng1.Row
     i = i + 1
   Loop While rng1.Address <> sAdd
 End If
Next

End Sub

--
Best Regards,

Luke M
*Remember to click "yes" if this post helped you!*







- Show quoted text -

Thank you whilst this has resolved part of the problem, in that it
clears cells C17:37 and copys over part of the row (sorry my question
did not give you the full picture in that there is only data in cols
A:H so it was those cols that i wanted to move over.)
However the array is nolonger working, The macro should check col3 in
worksheets 1 & 2 (in reality there are 17worksheets) and where it
finds a word that matches the combobox then that row (cols A to H)
would be copied to sheet3 starting at row C17. Your revised code only
checks sheet1, is it possible that it can check all worksheets.

With thanks