looping

chris1234567

New Member
Joined
Sep 21, 2006
Messages
12
I have the underneath code as you can see it looks in all the different ranges using the find command to find the letter T then copies that row to the front sheet the only trouble is it only finds one T per sheet I need it to copy all the T's on the sheet before it moves onto the next range.

Any help appreciated

Private Sub Worksheet_Activate()
Dim target
Dim range
Dim ws As Worksheet
Dim i
Dim rng(26) As Variant
Dim r
Set rng(1) = Sheets("a").range("b2:b50")
Set rng(2) = Sheets("b").range("b2:b50")
Set rng(3) = Sheets("b").range("b2:b50")
Set rng(4) = Sheets("d").range("b2:b50")
Set rng(5) = Sheets("e").range("b2:b50")
Set rng(6) = Sheets("f").range("b2:b50")
Set rng(7) = Sheets("g").range("b2:b50")
Set rng(8) = Sheets("h").range("b2:b50")
Set rng(9) = Sheets("i").range("b2:b50")
Set rng(10) = Sheets("j").range("b2:b50")
Set rng(11) = Sheets("k").range("b2:b50")
Set rng(12) = Sheets("l").range("b2:b50")
Set rng(13) = Sheets("m").range("b2:b50")
Set rng(14) = Sheets("n").range("b2:b50")
Set rng(15) = Sheets("o").range("b2:b50")
Set rng(16) = Sheets("p").range("b2:b50")
Set rng(17) = Sheets("q").range("b2:b50")
Set rng(18) = Sheets("r").range("b2:b50")
Set rng(19) = Sheets("s").range("b2:b50")
Set rng(20) = Sheets("t").range("b2:b50")
Set rng(21) = Sheets("u").range("b2:b50")
Set rng(22) = Sheets("v").range("b2:b50")
Set rng(23) = Sheets("w").range("b2:b50")
Set rng(24) = Sheets("x").range("b2:b50")
Set rng(25) = Sheets("y").range("b2:b50")
Set rng(26) = Sheets("z").range("b2:b50")
i = 1
For counter = 1 To 26

Set r = rng(i).Find("t")

If Not r Is Nothing Then
r.EntireRow.Copy Destination:=Sheets("reliance staff").Cells(Rows.Count, "b").End(xlUp).Offset(1, -1)
End If
i = i + 1
Next
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Hi,

there is a nice example in the helpfiles where you can see the structure to do this

remark 1
instead of
Set r = rng(i).Find("t")
you would better use the complete syntax
else the arguments will be like the previous settings: if you did a (manual) find using "lookat part of cell", you will find a lot more then using "lookat whole cell"
so unexpected results may occur

remark 2
try to put your rng-assingments in a loop, using the sheetindex
if you cant use the index, there are other possibilities ...

for i =1 to 26
Set rng(i) = Sheets(i).range("b2:b50")
next i


kind regards,
Erik
 
Upvote 0
the full sntaz

How do I go about finding step one ie making it find a "t" in the cell and NOT matching the entire cell contents
 
Upvote 0
Hi chris1234567

If the sheets are the first 26 sheets in the workbook, you can simplify you code using the sheets' index.

Try this code that finds "t" inside a cell's value

Code:
Option Explicit

Private Sub Worksheet_Activate()
Dim rC As range, i As Integer, sAddr As String

For i = 1 To 26

    With Worksheets(i).range("b2:b50")
        
        Set rC = .Find("t", lookat:=xlPart)
        If Not rC Is Nothing Then
            sAddr = rC.Address
            Do
                rC.EntireRow.Copy Destination:=Sheets("reliance staff").Cells(Rows.Count, "b").End(xlUp).Offset(1, -1)
                Set rC = .FindNext(rC)
            Loop While Not rC Is Nothing And rC.Address <> sAddr
        End If
    End With
Next
End Sub

Hope this helps
PGC

EDIT: Replaced test statement
 
Upvote 0
Hi again

I had a test statement instead your copy statement. I already replaced it,
 
Upvote 0
Re: the full sntaz

How do I go about finding step one ie making it find a "t" in the cell and NOT matching the entire cell contents
wouldn't you like feedback when taking the time to respond to a post ?

did you get to the helpfiles ?

in Excel press Alt+F11
you will get in the VBA-Editor
there click Help
now type FIND
you will get a list
click "FIND, Method"
you will get an extensive explanation
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,207
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top