Excel Macro remove punctuation and cut Name Help!@

[xxcucumberxx]

I having a problem With my macro. It has so many steps that causes my excel to not respond. It there a way to shorten the process. I need a Macro that Removes all punctuation by that i mean ,./':;"()| in column J starting in row 2. DO the same in column K row 2 but also remove - with a space. Also in column K row 2 Cut the first names down to 10 letters and cut column J starting in row 2 the last name down to 20 letters. Is this possible? This is what im using so far.

Columns("J:K").Select
Selection.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="/", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="'", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="""", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=")", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("K:K").Select
Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Columns("K:K").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1

Columns("K:K").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("K2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],20)"
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K7753")
Range("K2:K7753").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("J1").Select
Application.CutCopyMode = False
Selection.Copy
Range("K1").Select
ActiveSheet.Paste
Columns("J:J").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("K22").Select


Please help Maybe there is a better formula to use. Thank you so much who helps

 

[igold]

Hi,

See what this does for you. I am not quite sure what you want done with the last requirement as far as the number of letters in Columns J & K, but this should fill the beginning punctuation requirements.

Let me know what you need done after this code runs and we can add it in. Remember to please test this on a backup copy of your work. The changes it makes cannot be undone.

Sub NoPunct()


    Dim Punct() As Variant
    Dim lRow As Long
    Dim coluJK As Range
    Dim i As Long


    Set coluJK = Columns("J:K").Cells
    
    lRow = coluJK(Cells.Find(What:="*", SearchOrder:=xlRows, _
      SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row, _
      Cells.Find(What:="*", SearchOrder:=xlByColumns, _
      SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column).Row
    
    Punct() = Array(",", ".", "/", "'", ":", ";", "(", ")", "|", """", "- ")
    
    For i = LBound(Punct) To UBound(Punct) - 1
        Range("J2:J" & lRow).Replace What:=Punct(i), Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    Next
    For i = LBound(Punct) To UBound(Punct)
        Range("K2:K" & lRow).Replace What:=Punct(i), Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    Next
    Range("K2").Formula = "=Left(J2,10)"
    Range("K2").AutoFill Range("K2:K" & lRow)
    
    End Sub

Regards,

igold

 

[xxcucumberxx]

Thank you so much! Yes the formula works. But it leaves it in a formula, I need it to change it to value if its possible. About last requirement i need it cut column J starting from row 2 to 20 letters, I have last names and they need to all be cut down to 20 letters. Same thing with column K but have that cut down the first names to 10 letters. Once again thank you so much!

 

[igold]

Hi,

Thanks for the feedback. I think this is what you want:

Same warnings as before. Please test on a backup copy of your data

Sub NoPunct()


    Dim Punct() As Variant
    Dim lRow As Long
    Dim coluJK As Range
    Dim i As Long


    Set coluJK = Columns("J:K").Cells
    
    lRow = coluJK(Cells.Find(What:="*", SearchOrder:=xlRows, _
      SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row, _
      Cells.Find(What:="*", SearchOrder:=xlByColumns, _
      SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column).Row
    
    Punct() = Array(",", ".", "/", "'", ":", ";", "(", ")", "|", """", "- ")
    
    For i = LBound(Punct) To UBound(Punct) - 1
        Range("J2:J" & lRow).Replace What:=Punct(i), Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    Next
    For i = LBound(Punct) To UBound(Punct)
        Range("K2:K" & lRow).Replace What:=Punct(i), Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    Next
    For i = 2 To lRow
        Cells(i, 10).Value = Left(Cells(i, 10), 20)
        Cells(i, 11).Value = Left(Cells(i, 11), 10)
    Next
    
End Sub

Please let me know how it goes.

igold

 

[xxcucumberxx]

Thank you So so so much!!!!!!
Works Like a charm!@!@!@

 

[igold]

Great, glad I could help. Thanks again for the feedback...

igold

 

[Rick Rothstein]

Here is another macro that I think should also work for you...

Sub RemoveAllPunctuationAndShortenNames()
  Dim R As Long, C As Long, X As Long, Data As Variant
  Data = Range("K2:J" & Cells(Rows.Count, "K").End(xlUp).Row)
  For R = 1 To UBound(Data, 1)
    For C = 1 To 2
      If C = 2 Then Data(R, C) = Replace(Data(R, C), "- ", "")
      For X = 1 To Len(Data(R, C))
        If Mid(Data(R, C), X, 1) Like "[!A-Za-z0-9 ]" Then Mid(Data(R, C), X) = Chr(1)
      Next
      Data(R, C) = Left(Replace(Data(R, C), Chr(1), ""), 30 - 10 * C)
    Next
  Next
  Range("J2").Resize(UBound(Data), 2) = Data
End Sub

 

[igold]

Hey Rick and xxcucumberxx,

I just ran Rick's code on the test data that I used. Rick's code removes the punctuation "- " sans quotes, just the hyphen and space, from Column J. My code only removes that from Column K.

So the question is to xxcucumberxx: Which way is the way that you want. You can use my code or Rick's, but they are doing different things.

Just a heads-up that you may have overlooked.

Regards,

igold

 

[Rick Rothstein]

I just ran Rick's code on the test data that I used. Rick's code removes the punctuation "- " sans quotes, just the hyphen and space, from Column J. My code only removes that from Column K.

My code removes the dash/space from column K only (the space after any dash in Column J remains), but my code removes a single dash from both columns (since I considered the dash to be a punctuation mark). I wasn't completely clear on the OP's requirements because his list of punctuation marks is not complete, but my code removes anything that is not a letter, digit or space character from both columns... I did this because the OP said "I need a Macro that Removes all punctuation..."

 

[igold]

Removes all punctuation...

Yeah, he went on to qualify that statement...

by that i mean ,./':;"()|