Please help me with selecting the cell containing my search result in vba

[reflectingg0d]

Hello,

I'm pretty new at this, in fact I rely on recording various actions to get the code I need then piece them all together, but that's not helping me in this case.

I'm looking for a way to search for a word in column E. Once it is found, moving it to column A on the same row, then merging the cells in A:E on that row.

Sub Macro2()
'
' Macro2 Macro
'
'searching for the word andromeda
Cells.Find(What:="Andromeda", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range("E851").Select
Selection.AutoFill Destination:=Range("A851:E851"), Type:=xlFillDefault

Range("A851:E851").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
End Sub


That's what I recorded, autofill through column A gave the same result once the cells were merged, but the problem is that data isn't always going to be in row 851. How do I get it to select the cell that data is in, and fill the cells to the left when it's in a different row every time?

Your help is greatly appreciated!

 

[Mindpsyche]

Try This:

I'm no pro but this is what i managed.

Sub Findnmerge()
'
' Macro12 Macro
' Macro recorded 6/8/2012 by 703064732
'
    Dim lr As Long, r As Range, r1, r2 As Long, str As String
    lr = Cells(Rows.Count, 5).End(xlUp).Row
    Set r = Range(Cells(1, 5), Cells(lr, 5))
    r.Select
    For Each r1 In r
        str = "ANDROMEDA"
        If r1.Value = str Then
        Selection.End(xlToLeft).Select
        r2 = ActiveCell.Row
        Range(Cells(r2, 1), Cells(r2, 5)).Select
                With Selection
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlBottom
                        .WrapText = False
                        .Orientation = 0
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                        .MergeCells = True
                End With
                        ActiveCell.Offset(1, 0).Offset(0, 4).Select
            ElseIf r1.Value <> str Then
            ActiveCell.Offset(1, 0).Select
        End If
    Next r1
End Sub

 

[reflectingg0d]

Thanks, That worked great!

Is there a simple way to make this do the same thing with multiple search terms or do I need to reuse this with new designations for each search term? There are about 50 instances I need to search and merge like this

 

[Michael M]

Just an aside to the main question...
Try to avoid merging cells at any price.
They will give you nightmares especially if you have to start filtering, copying and pasting, etc.
Simply change

.HorizontalAlignment = xlCenter
TO

.HorizontalAlignment = xlCenterAcrossSelection

and delete the Merged cells = true line

 

[Mindpsyche]

Try this:

I tried to do what Michael suggested but it bugged out and as I am still new i stuck to the old code.

I am basically using an inputbox to type in the item.

Sub Findnmerge()
'
' Macro12 Macro
' Macro recorded 6/8/2012 by 703064732
'
    Dim lr As Long, r As Range, r1, r2 As Long, str As String
    lr = Cells(Rows.Count, 5).End(xlUp).Row
    Set r = Range(Cells(1, 5), Cells(lr, 5))
    r.Select
    str = InputBox("Enter Search Item")
    For Each r1 In r
        If r1.Value = str Then
        Selection.End(xlToLeft).Select
        r2 = ActiveCell.Row
        Range(Cells(r2, 1), Cells(r2, 5)).Select
                With Selection
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlBottom
                        .WrapText = False
                        .Orientation = 0
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                        .MergeCells = True
                End With
                        ActiveCell.Offset(1, 0).Offset(0, 4).Select
            ElseIf r1.Value <> str Then
            ActiveCell.Offset(1, 0).Select
        End If
    Next r1
End Sub

You can even re-run this on the same range, where you have run it before. It seems to work.