Remove Asterisk and extra space from cell

[zubair99]

Hi,
I need to remove Asterisk and extra space from cell check this.

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Original Description[/TD]
[TD]After Clean Asterisk and Space[/TD]
[/TR]
[TR]
[TD]Get a sparkly look with Our Signature Swarovski Crystal Teardrop Stud Earrings, faceted for extra shine in a delicious variety of colors finishes and styles

IF YOU WANT THE BEST CHOSE THE ORIGINAL
Top Quality Materials -Excellent Customer Service -Swarovski Authentications Tags -

Petite Delights is an Official SWAROVSKI
Official Swarovski Elements Partner Made with real genuine high quality Austrian Swarovski ©Crystal .
Our brand is legally licensed & authorized By Swarovski Company for high quality manufacturing.
This pair comes with Swarovski genuine tag , this is unique to our store .
They serve as a sign of quality and authenticity of the crystals used in my designs

Details :
-Materials- 14 k Gold Plated over brass CRYSTALLIZED Swarovski Element.
-Post stud earrings, posts located at the top
-Size 28.5 mm x 13.50 mm ( 1" x 0.50)
-Color Mint Coral
-Stones are hand set in secure prongs
-Earrings Are Nickel Free
-Bridal - Bridesmaid











Made with love

Petite delights
Ilona


Item Sku: ESWY1246







** **[/TD]
[TD]Get a sparkly look with Our Signature Swarovski Crystal Teardrop Stud Earrings, faceted for extra shine in a delicious variety of colors finishes and styles

IF YOU WANT THE BEST CHOSE THE ORIGINAL
Top Quality Materials -Excellent Customer Service -Swarovski Authentications Tags -

Petite Delights is an Official SWAROVSKI
Official Swarovski Elements Partner Made with real genuine high quality Austrian Swarovski ©Crystal .
Our brand is legally licensed & authorized By Swarovski Company for high quality manufacturing.
This pair comes with Swarovski genuine tag , this is unique to our store .
They serve as a sign of quality and authenticity of the crystals used in my designs

Details :
-Materials- 14 k Gold Plated over brass CRYSTALLIZED Swarovski Element.
-Post stud earrings, posts located at the top
-Size 28.5 mm x 13.50 mm ( 1" x 0.50)
-Color Mint Coral
-Stones are hand set in secure prongs
-Earrings Are Nickel Free
-Bridal - Bridesmaid

Made with love
Petite delights
Ilona
Item Sku: ESWY1246[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Please Help me as soon as possible.
Thank You in Advance.

 

[AliGW]

Just delete it???

 

[zubair99]

Just delete it???

I have 1300 rows like this I Need this work automatically. Manual working take more time even many days
to fix this problem.

I need auto function/formula whatever you have.

thanks

 

[tygrrboi]

Kind of Quick and Dirty but...

put this in a module and then run the macro. Change the blue range to your actual range.

Sub Test()
Const TwoX As String = vbNewLine & vbNewLine
Const ThreeX As String = TwoX & vbNewLine
Dim Result As String
Dim R As Range


For Each R In ActiveSheet.Range("[COLOR=#0000ff]A1:D1[/COLOR]")
    Result = Replace(R.Value, "*", "")
OneMoreTime:
    Result = Replace(Result, ThreeX, TwoX)
    If Len(Result) <> Len(Replace(Result, ThreeX, "")) Then GoTo OneMoreTime
    Result = Left(Result, Len(Result) - 2)
    R.Value = Result
Next R
End Sub

 

[zubair99]

Your codes are good but its only remove Asterisk. Extra space not remove.

 

[Peter_SSs]

Try this macro. It currently uses the data in column A and writes the results to column B. You can alter those columns to suit, including writing the results back over the original data if you want.

Sub FixEm()
  Dim a As Variant
  Dim i As Long
  
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  With CreateObject("VBScript.RegExp")
    .Pattern = "[\s\*]*$"
    For i = 1 To UBound(a)
      a(i, 1) = .Replace(a(i, 1), "")
    Next i
  End With
  Range("B1").Resize(UBound(a)).Value = a
End Sub

 

[navic]

Try this VBA published here

Sub RemoveBlankLines()
    Dim rngCel As Range
    Dim strOldVal As String
    Dim strNewVal As String
    Application.ScreenUpdating = False
    For Each rngCel In Selection
        strOldVal = rngCel.Value
        Do
            strNewVal = Replace(strOldVal, vbLf & vbLf & vbLf, vbLf & vbLf)
            If strNewVal = strOldVal Then Exit Do
            strOldVal = strNewVal
        Loop
        If rngCel.Value <> strNewVal Then
            rngCel = strNewVal
        End If
    Next rngCel
    Application.ScreenUpdating = True
End Sub

 

[zubair99]

Extra line space not removed i am sending Excel worksheet to you Please check and suggest the good functions for it.

Worksheet dropbox link

Thank in Advance

 

[Peter_SSs]

You have not described your data or your requirement adequately, so it is no surprise that the suggestions have not done what you wanted.

Until now you had provided one example. That example clearly had a lot of blank space and some asterisks at the end of it & you asked for that to be deleted.

With your data now provided ..
a) Not one of the cells has asterisks at the end.
b) Some of your data has asterisks "near" the end, but they are followed by other text. Not only is this unlike your previous example, you haven't made it clear whether to only remove the blank space and asterisks or remove the blank space, asterisks and the text that follows.
c) Some of your data (eg row 84) has asterisks half way through the text. What has to be removed from that cell?
d) Some of your data (eg row 125) has space followed by asterisks both in the middle and at the end. What is the expected result for that cell?

You need to provide a precise set of "rules" if you expect helpers to invest time into your problem and an answer that meets your needs.

Remember all we know about your sheet, data and requirements is what you tell us and show us, anything else we have to guess.

 

[tygrrboi]

Last attempt before I give up.

I looked at the code() for each character in one of your examples from the file and discovered that vbnewline probably wasnt the best choice so I will make an alteration. (again.. where you change the blue range to meet your data.)

[COLOR=#333333]Sub Test()

[/COLOR]Const TwoX As String = vbCr & vbCr
Const ThreeX As String = TwoX & vbCr
Dim Result As String
Dim R As Range


For Each R In ActiveSheet.Range("[COLOR=#0000ff]A1:A1000[/COLOR]")
    Result = Replace(R.Value, "*", "")
OneMoreTime:
    Result = Replace(Result, ThreeX, TwoX)
    If Len(Result) <> Len(Replace(Result, ThreeX, "")) Then GoTo OneMoreTime
    Result = Left(Result, Len(Result) - 2)
    R.Value = Result
Next R 

[COLOR=#333333]End Sub
[/COLOR]