Link to home
Start Free TrialLog in
Avatar of Andreas Hermle
Andreas HermleFlag for Germany

asked on

add a manual line break before each and every substring that starts with 'X0' using VBA

Dear Experts:

I would like to run a macro on selected cells that perform the following action:

The macro is to add a manual line break before each and every substring that starts with 'X0****'

 User generated image
The macro is to run these actions in the cell itself not copying the cell contents to the right and perform the action there.

The cell height has to be adjusted depending on the number of line breaks that get inserted.

Help is very much appreciated. I have attached a sample file for your convenience.

Regards, Andreas

Insert_manual_link_break_before_eve.xlsx
SOLUTION
Avatar of Rob Henson
Rob Henson
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
I just noticed that you seem to want the first two "X0"s to be on the same line. If so then use this code instead.
Sub InsertBreaks()
Dim lngLastRow As Long
Dim lngRow As Long
Dim strParts() As String
Dim intLine As Integer

lngLastRow = Range("A1048576").End(xlUp).Row
For lngRow = 1 To lngLastRow
    strParts = Split(Trim(Cells(lngRow, "A")), "X0")
    If UBound(strParts) > 0 Then
        Cells(lngRow, "A") = ""
        For intLine = 1 To UBound(strParts)
            Select Case True
                Case intLine = 1
                    Cells(lngRow, "A") = "X0" & strParts(1) & " " & "X0" & strParts(2) & vbCrLf
                Case intLine = 2
                    ' Already used
                Case intLine < UBound(strParts)
                    Cells(lngRow, "A") = Cells(lngRow, "A") & "X0" & strParts(intLine) & vbCrLf
                Case Else
                    Cells(lngRow, "A") = Cells(lngRow, "A") & "X0" & strParts(intLine)
            End Select
        Next
        Cells(lngRow, "A").EntireRow.AutoFit
    End If
Next
End Sub

Open in new window

Avatar of Andreas Hermle

ASKER

As a matter of fact you both deserve 1000 points. Great job from both of you. I really appreciate it. Regards, Andreas

T H A N K    Y O U    very much
You’re welcome and I’m glad I was able to help.

If you expand the “Full Biography” section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
              Experts Exchange MVE 2015
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2017