Excel macro to find all instances of text,select the cell and the next 3 lower cells, cut and transpose to another cell

Hello,

I would like to create an Excel macro, or just a one time sequence, to find all instances of some text, select the cell and the next 3 lower cells, cut and transpose to another cell

Thanks,
Matt
mbrombAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Shahid ThaikaSole ProprietorCommented:
Why don't you just use the in-built find feature. You can do 'Find All' to highlight all the found cells and then you can Right click, say copy/cut and then paste it into your other sheet.
0
mbrombAuthor Commented:
I can find all, but then I need to select the 4 cells below, cut/paste them adjacent to the originally selected cell.  i can't do that AFAIK with the Find.
0
Shahid ThaikaSole ProprietorCommented:
Ah! In that case, in a loop find every case of your text (Record a macro, if you don't know how). The find will either return false or the range of the found cell. Next you can use VBA's offset function to copy-paste.
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

mbrombAuthor Commented:
what I have right now is a macro that does a single instance.  Then i can hit a shortcut key 70 times to have it do the rest of the instances.  If I hit it shortcut one too many times it starts again at the top and screws up the doc, and there seems to be no way to undo a macro change.
0
Shahid ThaikaSole ProprietorCommented:
That's why you need to put it in a loop. I'd help more, but I currently don't have access to Excel and whatever I am saying is from the top of my head. You can do something like...

While(Sheet1.Find("Something", Direction:=TopDown) = True)
    Selection.Offset(1, 0).Copy NewRange
    Selection.Offset(2, 0).Copy NewRange
    Selection.Offset(3, 0).Copy NewRange
Wend


Make sure you give all the parameters in the Find function, including those to search in one direction (top-down) and the parameter that finds the next instances only. Then your macro will not start from the beginning.
0
mbrombAuthor Commented:
Here's the macro code.  I'm not sure how to incorporate the loop.


----------------------------------------------------
Sub store()
'
' store Macro
'
' Keyboard Shortcut: Ctrl+t
'
    ActiveCell.Offset(-1, 0).Range("A1").Select
    Cells.Find(What:="store:", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(1, 0).Range("A1:A5").Select
    Selection.Copy
    ActiveCell.Offset(-1, 1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveCell.Offset(1, 0).Rows("1:5").EntireRow.Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
End Sub
----------------------------------------------------
0
Shahid ThaikaSole ProprietorCommented:
Perhaps something like this solves your purpose.
Sub store()
'
' store Macro
'
' Keyboard Shortcut: Ctrl+t
'
    Dim sRow As Double
    
    On Error GoTo Err
    
    ActiveCell.Offset(-1, 0).Range("A1").Select
    
    While (Cells.Find(What:="store:", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate)

        'check if we are resuming again from top (We don't want this)
        If ActiveCell.Row <= sRow Then Exit Sub
        If sRow = 0 Then sRow = ActiveCell.Row

        ActiveCell.Offset(1, 0).Range("A1:A5").Select
        Selection.Copy
        ActiveCell.Offset(-1, 1).Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        ActiveCell.Offset(1, 0).Rows("1:5").EntireRow.Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlUp
    Wend
        Exit Sub
Err:
        Debug.Assert False
        Resume Next
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mbrombAuthor Commented:
i didn't have any luck with the script and unfortunately I've had to drop this.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.