Excel VBA - Searching in a Loop

Question

First, my code (below) works, but I am trying to see if it can be simplified. The macro in which this code is located will have a lot of specific search items and I want to make it as efficient as possible.

It is searching for records with a specific category (in this case "Chemistry") then copying those records into another workbook. I feel like using Activate in the search, and using Select when moving to the next cell are taking too much time and resources, but I don't know how to code it to where it doesn't have to do that.

Here are the specifics:

Search column T for "Chemistry"
Once it finds "Chemistry", set that row as the "top" record. e.g. A65
Move to the next row down, and if that cell contains "Chemistry", move to the next row (the cells that contain "Chemistry" will all be together"
Keep going until it doesn't find "Chemistry", then move up one row
Set that row for the "bottom" record. e.g. AX128
Combine the top and bottom rows to get the range to select. e.g. A65:AX128
Copy that range and paste it into another workbook

Here is the code:

'find "Chemistry"

Range("T1").Select

Cells.Find(What:="Chemistry", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False).Activate

'set top row for selection
toprow = ActiveCell.Row
topcellselect = "A" & toprow

'find all rows for Chemistry
Do While ActiveCell = "Chemistry"
ActiveCell.Offset(1, 0).Select
Loop

ActiveCell.Offset(-1, 0).Select

'set bottom row for selection
bottomrow = ActiveCell.Row
bottomcellselect = "AX" & bottomrow

'define selection range from top and bottom rows
selectionrange = topcellselect & ":" & bottomcellselect

'copy selection range
Range(selectionrange).Copy

'paste into appropriate sheet
wb1.Activate
Sheets("Chemistry").Select
Range("A2").PasteSpecial

Thanks in advance for any help!

David G · Accepted Answer · 2016-07-11 20:27:42Z

2

You never need to select or activate unless that's really what you want to do (at the end of the code, if you want the user to see a certain range selected). To remove them, just take out the activations and selections, and put the things on the same line. Example:

wb1.Activate
Sheets("Chemistry").Select
Range("A2").PasteSpecial

Becomes

wb1.Sheets("Chemistry").Range("A2").PasteSpecial

For the whole code; I just loop thorugh the column and see where it starts and stops being "chemistry". I put it in a Sub so you only have to call the sub, saying which word you're looking for and where to Paste it.

Sub tester
    Call Paster("Chemistry", "A2")
End sub

Sub Paster(searchWord as string, rngPaste as string)
    Dim i as integer
    Dim startRange as integer , endRange as integer
    Dim rng as Range

    With wb1.Sheets("Chemistry")

        For i = 1 to .Cells(Rows.Count,20).End(XlUp).Row
            If .Range("T" & i ) = searchWord  then 'Here it notes the row where we first find the search word
                startRange = i
                Do until .Range("T" & i ) <> searchWord 
                    i = i + 1 'Here it notes the first time it stops being that search word
                Loop
                endRange = i - 1 'Backtracking by 1 because it does it once too many times
                Exit for
            End if
        Next


        'Your range goes from startRange to endRange now
        set rng = .Range("T" & startRange & ":T" & endRange)

        rng.Copy

        .Range(rngPaste).PasteSpecial 'Paste it to the address you gave as a String

    End with
End sub

As you can see I put the long worksheet reference in a With to shorten it. If you have any questions or if it doesn't work, write it in comments (I haven't tested)

edited Jul 11, 2016 at 20:27

answered Jul 11, 2016 at 20:20

David G

2,3652 gold badges27 silver badges45 bronze badges

Sign up to request clarification or add additional context in comments.

6 Comments

David G Over a year ago

Also, I'm using T all the time because I'm not sure I understood when you wanted T and when you wanted A. So change as desired! .Cells(Rows.Count,20).End(XlUp).Row finds the last used row in the 20th column, which is T.

David G Over a year ago

Now it searches T and pastes in A

user646464 Over a year ago

David, a few questions: 1) Can .Cells(Rows.Count,20).End(XlUp).Row be modified to look only at the cells that contain data? Right now it looks at every row in the sheet (1,048,576). 2) When I run the macro, startRange and endRange are both set to 0. In the code, I don't think they ever get set to i or i -1, respectively. How do I fix that?

David G Over a year ago

.Cells(Rows.Count,20).End(XlUp).Row Goes down the entire sheet (up to row 1,048,576, you're right) and comes back up until it meets a cell. The row given is the row of the first cell it meets that has a value. If you start it at 100 for example, instead of Rows.Count (which is equal to 1,048,576) it will start going up from there instead and give you the first cell it meets, counting from row 100. Does that answer your question about that?

David G Over a year ago

I'm not sure I understand what you mean with your second question. In the code, they do get set to values, so do you mean that the code never enters the If .Range("T" & i ) = searchWord then section? To make sure that it doesn't, set a break point on startRange = i and run the macro. See if it stops there. If it doesn't, then the column the code is looking at doesn,t contain the searchword. Make sure the searchword is the one you want to search for and that the column is the right one too.

|

user6432984 · Accepted Answer · 2016-07-11 23:44:58Z

The most efficient way is to create a Temporary Custom Sort Order and apply it to your table.

Sub MoveSearchWordToTop(KeyWord As String)
    Dim DestinationWorkSheet As Workbook

    Dim SortKey As Range, rList As Range

    Set SortKey = Range("T1")

    Set rList = SortKey.CurrentRegion
    Application.AddCustomList Array(KeyWord)


    rList.Sort Key1:=SortKey, Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

    Application.DeleteCustomList Application.CustomListCount

    Set DestinationWorkSheet = Workbooks("Some Other Workbook.xlsx").Worksheets("Sheet1")

    rList.Copy DestinationWorkSheet.Range("A1")

End Sub

Collectives™ on Stack Overflow

Excel VBA - Searching in a Loop

2 Answers 2

6 Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

6 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related