[DictatorDrac]

i've never touched visual basic before, but i managed to take the source from FindItAll (though i don't think it was the actual source seeing as how it didn't work) and edit it to fit my needs.

looking to make a VB macro in Excel that will find a cell and move the entire row that cell is in to the top. doing this for work, and my boss knows i'm not a programmer. i think he wants me to learn. if anyone could point out bugs or tell me commands, it would be much appreciated.

here's the code:

Sub FindAndMoveToTop()
    Dim FoundCell As Range
    Dim WhatToFind As Variant
    'Window prompt allowing user to define WhatToFind
    WhatToFind = Application.InputBox("What are you looking for?", "Search", , 100, 100, , , 2)
    'If WhatToFind is a value and not blank, move on
    If WhatToFind <> "" And Not WhatToFind = False Then
        'Start with first worksheet
        Worksheets("Sheet1").Activate
        'Start at first cell
        Range("A1").Select
            'Loop as many times as there are used rows
            For x = 1 To ActiveSheet.UsedRange.Rows.Count
                'Find the first cell containing WhatToFind (specified by user)
                Set FoundCell = Cells.Find(What:=WhatToFind, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                'If FirstCell exists, move on
                If Not FoundCell Is Nothing Then
                    'Ok, First Cell is set
                    FoundCell.Activate
                    'Select all rows containing WhatToFind - NOT WORKING ARRGGGHHHH!!! only selecting the cell, not the row.
                    'Also, if >1 instance of WhatToFind, acts funky...
                    'Fixed the following line thanks to user Brassman on Microsoft Excel Programmer forums
                    Worksheets("Sheet1").Rows(ActiveCell.Row).EntireRow.Select
                    'Cut all rows containing WhatToFind
                    Selection.Cut
                    'Back to A1
                    Cells(1, 1).Select
                    'Insert cut rows here
                    Selection.Insert Shift:=xlDown
                    'Keep going
                    On Error Resume Next
                End If
            Next x
        'Clean up
        Set FoundCell = Nothing
        Range("A1").Select
    End If
End Sub

only problem is that it only moves the first two results...

any ideas?

[OBP]

One reason it is not working is that it doesn't "find" what you ask it to find. It stops at the first row (a2) and then inserts the row at "a1"

[OBP]

I can do this for you, but not using the "Find" function.