Trying to merge cells across with * at the start of the text

[Darren Smith]

Find the * in a text string then merge the text across the columns.
At the moment it seems to just merge a load of random cells

Sub MergeCells()
    Dim myFirstRow As Long
    Dim myLastRow As Long
    Dim myCriteriaColumn As Long
    Dim myFirstColumn As Long
    Dim myLastColumn As Long
    Dim ws As Worksheet
    Dim myCriteria As String
    Dim iCounter As Long
 
    myFirstRow = 13
    myCriteriaColumn = 5
    myFirstColumn = 5
    myLastColumn = 14
    myCriteria = "Merge cells"
 
    Set ws = ThisWorkbook.Worksheets("Job Card with Time Analysis")
 
    With ws
 
        myLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
        For iCounter = myLastRow To myFirstRow Step -1
            If .Cells(iCounter, myCriteriaColumn).Value = myCriteria Then .Range(.Cells(iCounter, myFirstColumn), .Cells(iCounter, myLastColumn)).Merge
        Next iCounter
 
    End With
 

End Sub

 

[jasonb75]

You can, the link would have to be posted in this thread though, not in a private message.

 

[Darren Smith]

Here is the workbook

Transfer - Dropbox

Dropbox is a free service that lets you bring your photos, docs, and videos anywhere and share them easily. Never email yourself a file again!

www.dropbox.com

 

[jasonb75]

The text will only flow from and to individual cells. It will not flow from a cell that is already merged (E and F) or into another cell that is merged (I and J).

Unmerging those cells allows the text to flow across as required.

 

[Darren Smith]

Thanks very much all is working now