Tom Ogilvy code

[RJG]

I found some really great code on this board written by a gentleman by
the name of Tom Ogilvy.

It works from a command button on sheet4 and it searches col3 in
sheet1 and sheet2 (in reality I have about 20 sheets to search
through.) for a word shown in a combobox on shee4. When it finds any
matches it copies those rows to sheet3.

So simple and what compact code— you just input your search word press
the button and you get the results on sheet3 straight away.


For my own needs I would like to make the following changes and would
be grateful for help in doing so please.

I need to change two minor items in the code;-
Firstly when it finds a matching row it outputs that whole row to
sheet3 starting at A2. I only need it to copy Cols A,C F&G and I would
like it to paste to sheet3 starting at B17.

Secondly each time the macro is run it adds to the bottom of the
previous run, before it starts I would like it to delete anything on
sheet3 between B17 and B37.

Somebody did try and give a hand with this and whilst it then pasted
to sheet3 B17 it then stopped the array working and only searched
sheet1.


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


With thanks

Bob

 

[KC]

Something like:
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

Dim rownr as long
Dim j as integer
worksheets("sheet3").rows("17:37").clearcontents

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

rownr=rng1.row
Do
worksheets("Sheet3").cells(17+j,"B")=sh.cells(rownr,"A")
worksheets("Sheet3").cells(17+j,"C")=sh.cells(rownr,"C")
worksheets("Sheet3").cells(17+j,"D")=sh.cells(rownr,"F")
worksheets("Sheet3").cells(17+j,"E")=sh.cells(rownr,"G")
j=j+1

Set rng1 = rng.FindNext(rng1)
Loop While rng1.Address <> sAdd
End If
Next

End Sub

 

[Bob]

Something like:
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

Dim rownr as long
Dim j as integer
worksheets("sheet3").rows("17:37").clearcontents

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

rownr=rng1.row
Do
worksheets("Sheet3").cells(17+j,"B")=sh.cells(rownr,"A")
worksheets("Sheet3").cells(17+j,"C")=sh.cells(rownr,"C")
worksheets("Sheet3").cells(17+j,"D")=sh.cells(rownr,"F")
worksheets("Sheet3").cells(17+j,"E")=sh.cells(rownr,"G")
j=j+1

Set rng1 = rng.FindNext(rng1)
Loop While rng1.Address <> sAdd
End If
Next

End Sub















- Show quoted text -

EXCELLANT, spot on thank you very much.

Bob