Substitution and removing of the string

[topi1]

I need a VBA for the following if someone can please help. Thank you in advance,

The data is in the column R.
Case insensitive match.
There are intermittent blank rows, but they can be removed first if absolutely necessary.

Function 1 of the VBA:
In all cells BELOW the cell that contains "TITLE2", I would like " shows" and " show" to be substituted with ":". Please notice that the preceding space is included. " shows" and " show" are part of the strings.
Function 2 of the VBA:
In all cells ABOVE the cell that contains "TITLE2", I would like " shows" and " show" as well everything to their left removed.

Here is the example.

BEFORE:

Book1
	R
1	Movies
2	TITLE1
3
4	Eros shows Star Wars
5	Strand and Regal show Superman.
6
7	TITLE2
8	Eros shows Star Wars
9	Strand and Regal show Superman.
Sheet2

AFTER (DESIRED OUTPUT):

Book1
	R
1	Movies
2	TITLE1
3
4	Eros: Star Wars
5	Strand and Regal: Superman.
6
7	TITLE2
8	Star Wars
9	Superman.
Sheet2

 

[dreid1011]

Your desired output seems to be opposite of what you described above; also, is VBA a strict requirement?

 

[Cubist]

This is based on your minisheet result.

Sub SubSetRange()
    Dim ws As Worksheet
    Dim title2Cell As Range
    Dim title1Range As Range
    Dim title2Range As Range
    Dim lastRow As Long
    Dim cell As Range
    Dim cellValue As String
    Dim pos As Long

    Set ws = ThisWorkbook.Sheets("Sheet2")

    Set title2Cell = ws.Columns("R").Find(What:="TITLE2", LookIn:=xlValues, LookAt:=xlWhole)

    If Not title2Cell Is Nothing Then
        Set title1Range = ws.Range("R1", title2Cell)

        For Each cell In title1Range
            cellValue = cell.Value
            cellValue = Replace(cellValue, " shows", ":")
            cellValue = Replace(cellValue, " show", ":")
            cell.Value = cellValue
        Next cell

        lastRow = ws.Cells(ws.Rows.Count, "R").End(xlUp).Row

        Set title2Range = ws.Range(title2Cell, ws.Cells(lastRow, "R"))

        For Each cell In title2Range
            cellValue = cell.Value
            pos = InStr(cellValue, " shows")
            If pos = 0 Then
                pos = InStr(cellValue, " show")
            End If
            If pos > 0 Then
                cellValue = Mid(cellValue, pos + Len(" shows"))
                If Left(cellValue, 1) = " " Then
                    cellValue = Mid(cellValue, 2)
                End If
            End If
            cell.Value = cellValue
        Next cell
    Else
        MsgBox "TITLE2 not found in column R."
    End If
End Sub

 

[topi1]

Your desired output seems to be opposite of what you described above; also, is VBA a strict requirement?

True. That’s what happens when you are rushed and try to get it done before going out. My apologies. I miswrote. The example is accurate. Thanks.

 

[topi1]

This is based on your minisheet result.

Sub SubSetRange()
    Dim ws As Worksheet
    Dim title2Cell As Range
    Dim title1Range As Range
    Dim title2Range As Range
    Dim lastRow As Long
    Dim cell As Range
    Dim cellValue As String
    Dim pos As Long

    Set ws = ThisWorkbook.Sheets("Sheet2")

    Set title2Cell = ws.Columns("R").Find(What:="TITLE2", LookIn:=xlValues, LookAt:=xlWhole)

    If Not title2Cell Is Nothing Then
        Set title1Range = ws.Range("R1", title2Cell)

        For Each cell In title1Range
            cellValue = cell.Value
            cellValue = Replace(cellValue, " shows", ":")
            cellValue = Replace(cellValue, " show", ":")
            cell.Value = cellValue
        Next cell

        lastRow = ws.Cells(ws.Rows.Count, "R").End(xlUp).Row

        Set title2Range = ws.Range(title2Cell, ws.Cells(lastRow, "R"))

        For Each cell In title2Range
            cellValue = cell.Value
            pos = InStr(cellValue, " shows")
            If pos = 0 Then
                pos = InStr(cellValue, " show")
            End If
            If pos > 0 Then
                cellValue = Mid(cellValue, pos + Len(" shows"))
                If Left(cellValue, 1) = " " Then
                    cellValue = Mid(cellValue, 2)
                End If
            End If
            cell.Value = cellValue
        Next cell
    Else
        MsgBox "TITLE2 not found in column R."
    End If
End Sub

Thank you. I’ll try soon.

 

[topi1]

@Cubist That is it. Works great. Thank you very much.

 

[jolivanes]

You have a solution but I had started on it so I assume you don't mind that, after a few hours pause working on it, I post it.

Sub Another_Possibility()
Dim rep1, rep2, c As Range, i As Long
Dim rng1 As Range, rng2 As Range
Set rng1 = Range(Cells(1, 3), Cells(Columns(3).Find("TITLE2", , , 1).Row - 1, 3))
Set rng2 = Range(Cells(Columns(3).Find("TITLE2", , , 1).Row + 1, 3), Cells(Cells(Rows.Count, 3).End(xlUp).Row, 3))
rep1 = Array(" shows", " show")
For Each c In rng1
    For i = LBound(rep1) To UBound(rep1)
        c = Replace(c, rep1(i), ": ")
    Next i
Next c
For Each c In rng2
    For i = LBound(rep1) To UBound(rep1)
        If InStr(c.Value, rep1(i)) > 0 Then c.Value = Trim(Mid(c.Value, InStr(c.Value, rep1(i)) + Len(rep1(i))))
    Next i
Next c
End Sub

 

[smozgur]

@Cubist That is it. Works great. Thank you very much.

I have switched the marked solution post accordingly. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread.

 

[topi1]

You have a solution but I had started on it so I assume you don't mind that, after a few hours pause working on it, I post it.

Sub Another_Possibility()
Dim rep1, rep2, c As Range, i As Long
Dim rng1 As Range, rng2 As Range
Set rng1 = Range(Cells(1, 3), Cells(Columns(3).Find("TITLE2", , , 1).Row - 1, 3))
Set rng2 = Range(Cells(Columns(3).Find("TITLE2", , , 1).Row + 1, 3), Cells(Cells(Rows.Count, 3).End(xlUp).Row, 3))
rep1 = Array(" shows", " show")
For Each c In rng1
    For i = LBound(rep1) To UBound(rep1)
        c = Replace(c, rep1(i), ": ")
    Next i
Next c
For Each c In rng2
    For i = LBound(rep1) To UBound(rep1)
        If InStr(c.Value, rep1(i)) > 0 Then c.Value = Trim(Mid(c.Value, InStr(c.Value, rep1(i)) + Len(rep1(i))))
    Next i
Next c
End Sub

I do have a solution from @Cubist . However, I appreciate your help and effort. I tried your code since you spent time helping me. I got a following error message.
And the following line was highlighted yellow.

Set rng1 = Range(Cells(1, 3), Cells(Columns(3).Find("TITLE2", , , 1).Row - 1, 3))

 

[jolivanes]

It works perfect here but as you mentioned, you have a workable solution.
Did you change the 3 to 18, in both line 4 and line 5, to represent Column R instead of Column C?