Delete duplicate text in cell

[JimH]

I have a spreadsheet that has duplicate sentences in all the cells in Column B, and I would like an automated way to delete the duplicate text. For example, cell B1 contains the following text: *See spot run. *See spot run.

I'm thinking a macro could be written to find the first asterisk then the second and then delete everything after the second asterisk. This process would be repeated on every cell in the column.

There may be a better way, but this is all I could come up with.

Everyone's help would be greatly appreciated.

Thank you.

 

[jbeaucaire]

Try this:

Option Explicit

Sub BetweenStars()
Dim RNG As Range
Dim Cell As Range

Set RNG = Range("B:B").SpecialCells(xlConstants)

    For Each Cell In RNG
        If InStrRev(Cell, "*") > 1 Then _
            Cell = Left(Cell, InStrRev(Cell, "*"))
    Next Cell

End Sub

 

[JimH]

Thanks, Jerry. It works great.

What would you add to the code to make it delete the asterisks after deleting the duplicate text?

 

[alx7000]

Hi JimH,

I'm no good with macros but the following formula might help as long as all duplicates follow the same format (will remove all asterisks, then just paste values if required)

=MID(B1,2,SEARCH("~*",B1,2)-3)

Cheers,
alx7000

 

[jbeaucaire]

What would you add to the code to make it delete the asterisks after deleting the duplicate text?

Maybe this:

Option Explicit

Sub BetweenStars()
Dim RNG As Range
Dim Cell As Range

Set RNG = Range("B:B").SpecialCells(xlConstants)

    For Each Cell In RNG
        If InStrRev(Cell, "*") > 1 Then _
            Cell = Trim(Replace(Left(Cell, InStrRev(Cell, "*")), "*", ""))
    Next Cell

End Sub

 

[pgc01]

Hi

If the second asterisc is always preceeded by a space, like in the example, you can also use Edit->Replace to delete the extra text. This would work in any spreadsheet that you receive without having to use macros or formulas.