Copy string part into new column, split the string value

[Harry Hof]

Hi,
I've a spreadsheet with many rows (60.000) and a few columns. I've made a macro with have to split the string in Column C into 2 parts and only the right part needs to be placed in the same row Column I. This Macro is very slow and most off the times is stops excel (Not responding)
The String in Column C can start with a few different texts ("AWEX ", "PO ", "AW ", "LE ", "SU ") or something compleet different text.
For example C2 contains "AWEX John Winter", C3 contains "PO William Sanders" and C4 contains "Jan Vender". I like to copy the String from C2 without the "PO " part into Column I2 so that it will be "John Winter" and C3 to I3 and should be "William Sanders" and I4 should be "Jan Vender".

My VBA knowledge is small so maybe some one can tell me if I have some wrong code in my macro that expains its speed or is it not well written, a wrong method choice to reach my goal?

Sub Names2()
Dim lastrow As Long
Dim myRow As Long
Dim Val As String
Dim NewVal As String
Dim Last As Long
Application.ScreenUpdating = False

    Sheets("Names").Select
'   Find last row in column B
lastrow = Cells(Rows.Count, "B").End(xlUp).Row

'   Loop for all cells in column C from rows 2 to last row

 If ActiveCell.Row = lastrow + 1 Then
 GoTo Last
 Else
For myRow = 2 To lastrow
Val = Cells(myRow, "C").Value
'   Check 5 and 3 character prefixes

              Select Case Left(Cells(myRow, "C"), 5)
                  Case "AWEX "
                      NewVal = Right(Val, Len(Val) - 5)
                      Cells(myRow, "I") = NewVal
              End Select
                   Select Case Left(Cells(myRow, "C"), 3)
                    Case "PO "
                        NewVal = Right(Val, Len(Val) - 3)
                        Cells(myRow, "I") = NewVal
                    Case "AW "
                        NewVal = Right(Val, Len(Val) - 3)
                       Cells(myRow, "I") = NewVal
                    Case "LE "
                        NewVal = Right(Val, Len(Val) - 3)
                        Cells(myRow, "I") = NewVal
                    Case "SU "
                        NewVal = Right(Val, Len(Val) - 3)
                        Cells(myRow, "I") = NewVal
                    End Select
          '  End Select
       ' End If
    'End If
Next myRow
Last:
End If
Application.ScreenUpdating = True
End Sub

 

[Rick Rothstein]

Assuming the prefix you want to remove always has 2 or more characters and assuming those characters are always upper case letters, give this macro a try (it replaces the macro you posted)...

Sub Names3()
  Dim R As Long, Arr As Variant
  Arr = Range("C2", Cells(Rows.Count, "C").End(xlUp))
  For R = 1 To UBound(Arr)
    If Arr(R, 1) Like "[A-Z][A-Z]*" Then Arr(R, 1) = Mid(Arr(R, 1), InStr(Arr(R, 1), " ") + 1)
  Next
  Range("I2").Resize(UBound(Arr)) = Arr
End Sub

 

[Peter_SSs]

In case there might be other upper case prefixes that you want kept, or just somebody's initials like TJ Washington, then you could use your Select Case idea like this.
The improvement is speed for both Rick's code & mine is basically that the worksheet values are all read into memory, the processing done there and then the results written back to the sheet. This is much faster than accessing the sheet twice (read then write) for each row.

Sub Split_Strings()
  Dim a As Variant
  Dim i As Long, pos As Long
  Dim s As String
  
  a = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    s = a(i, 1)
    pos = InStr(1, s, " ")
    Select Case Left(s, pos)
      Case "AWEX ", "PO ", "AW ", "LE ", "SU "
        a(i, 1) = Mid(s, pos + 1)
    End Select
  Next i
  Range("I2").Resize(UBound(a)).Value = a
End Sub

 

[Harry Hof]

In case there might be other upper case prefixes that you want kept, or just somebody's initials like TJ Washington, then you could use your Select Case idea like this.
The improvement is speed for both Rick's code & mine is basically that the worksheet values are all read into memory, the processing done there and then the results written back to the sheet. This is much faster than accessing the sheet twice (read then write) for each row.

Sub Split_Strings()
  Dim a As Variant
  Dim i As Long, pos As Long
  Dim s As String
 
  a = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    s = a(i, 1)
    pos = InStr(1, s, " ")
    Select Case Left(s, pos)
      Case "AWEX ", "PO ", "AW ", "LE ", "SU "
        a(i, 1) = Mid(s, pos + 1)
    End Select
  Next i
  Range("I2").Resize(UBound(a)).Value = a
End Sub

Thanks for the sugestions, Rick and Peter. I tested Peter his version and this is functioning well, quick en no error as I had with my own creation.
Thank you verry much.

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.