Splitting lower case from uppercase

[UZZY123]

harinsh,


Sample raw data:

Excel Workbook
	A	B
1	Bank of Ghana ACCRA
2	Bank of Ghana AGONA SWEDRU
3	Bank of Ghana TAKORADI
4	Bank of Ghana SEFWI BOAKO
5	Barclays Bank UNDP
6	Barclays Bank TWIFO PRASO
7	Barclays Bank WA
8	Rural & Community Banks AFRAM RURAL BANK LTD-TEASE
9	Ecobank ACCRA SHOPPING MALL
10	Amalgamated Bank SPINTEX ROAD
11	Fidelity Bank OKAISHIE
12
Sheet1

After the macro:

Excel Workbook
	A	B
1	Bank of Ghana	Accra
2	Bank of Ghana	Agona Swedru
3	Bank of Ghana	Takoradi
4	Bank of Ghana	Sefwi Boako
5	Barclays Bank	Undp
6	Barclays Bank	Twifo Praso
7	Barclays Bank	Wa
8	Rural & Community Banks	Afram Rural Bank Ltd-Tease
9	Ecobank	Accra Shopping Mall
10	Amalgamated Bank	Spintex Road
11	Fidelity Bank	Okaishie
12
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub MakeProperV2()
' hiker95, 03/05/2012
' http://www.mrexcel.com/forum/showthread.php?t=618547
Dim c As Range, Sp, s As Long, n As Long, t() As Variant
For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
  c = Trim(c)
  Sp = Split(c, " ")
  n = 0
  For s = LBound(Sp) To UBound(Sp)
    If Asc(Right(Sp(s), 1)) > 64 And Asc(Right(Sp(s), 1)) < 91 Then
      Sp(s) = Application.Proper(Sp(s))
      n = n + 1
      ReDim Preserve t(1 To n)
      t(n) = Sp(s)
      Sp(s) = ""
    End If
  Next s
  c = Join(Sp, " ")
  c = Trim(c)
  If n = 1 Then
    c.Offset(, 1).Value = t
  Else
    c.Offset(, 1).Value = Join(t, " ")
  End If
  Erase t
Next c
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm


Then run the MakeProperV2 macro.

Hi

I am looking for a macro like the above but the issue i have with this is that in mine i have numbers at the end which i also want including into the next coloum.
I have uploaded images of what i want and what the current macro does to make it easier for you to understand of what i need

Thank you for your help

 

[VBasic2008]

Hi

I am looking for a macro like the above but the issue i have with this is that in mine i have numbers at the end which i also want including into the next coloum.
I have uploaded images of what i want and what the current macro does to make it easier for you to understand of what i need

Thank you for your help

Could you correct me if I'm wrong: you want to split each string by the last two substrings (words) into two columns overwriting the initial column. No 'Proper' included.

 

[JoeMo]

Assuming the Uppercase strings are always last in the full string, as in your sample data, and that the uppercase substrings are always more than a single character in length:

Sub SplitIt()
Dim c As Range, V As Variant, i As Long, S As String
Application.ScreenUpdating = False
For Each c In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    V = Split(c.Value, " ")
    For i = LBound(V) To UBound(V)
        If Len(V(i)) > 1 Then
            If UCase(V(i)) = V(i) Then
                S = S & " " & V(i)
            End If
        End If
    Next i
    c.Value = Replace(c.Value, Trim(S), "")
    c.Offset(0, 1).Value = WorksheetFunction.Proper(Trim(S))
    S = ""
Next c
Range("A:B").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

 

[JLGWhiz]

Try this;

Sub t()
Dim spl As Variant
    With ActiveSheet
        For Each c In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
            spl = Split(c.Value, " ")
            c.Offset(, 2) = spl(UBound(spl) - 1) & " " & spl(UBound(spl))
        Next
    End With
End Sub

 

[UZZY123]

Assuming the Uppercase strings are always last in the full string, as in your sample data, and that the uppercase substrings are always more than a single character in length:

Sub SplitIt()
Dim c As Range, V As Variant, i As Long, S As String
Application.ScreenUpdating = False
For Each c In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    V = Split(c.Value, " ")
    For i = LBound(V) To UBound(V)
        If Len(V(i)) > 1 Then
            If UCase(V(i)) = V(i) Then
                S = S & " " & V(i)
            End If
        End If
    Next i
    c.Value = Replace(c.Value, Trim(S), "")
    c.Offset(0, 1).Value = WorksheetFunction.Proper(Trim(S))
    S = ""
Next c
Range("A:B").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

Thank you for the quick reply

This code works for some and others it dosnt. look at attached.
Also I like the uppercase to remain uppercase if possible

Thank you

 

[UZZY123]

Could you correct me if I'm wrong: you want to split each string by the last two substrings (words) into two columns overwriting the initial column. No 'Proper' included.

Sorry i dont really understand.

But what i want is that the colour and size move on the the next column while keeping them uppercase.
Just like the below image.
But to be more precise, sometimes the size are letters like S,M,L,XL or sometimes numbers 6,8,10 etc
also the colours could sometimes have spaces for example SKY BLUE

Thanks

 

[JoeMo]

Thank you for the quick reply

This code works for some and others it dosnt. look at attached.
Also I like the uppercase to remain uppercase if possible

Thank you

Keeping the uppercase in uppercase is easy. If you will use XL2BB to post the data in your image, showing the raw data, and (manually entered) the result you want, I will try to accommodate you.

 

[UZZY123]

Try this;

Sub t()
Dim spl As Variant
    With ActiveSheet
        For Each c In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
            spl = Split(c.Value, " ")
            c.Offset(, 2) = spl(UBound(spl) - 1) & " " & spl(UBound(spl))
        Next
    End With
End Sub

Thanks for the help unfortunately this gave an error message

 

[VBasic2008]

Sub splitByTwoLastSubstrings()
    
    Const FirstCell As String = "A1"
    Const ColumnOffset As Long = 0 ' 0 will overwrite, use > 0 to not.
    Const Delim As String = " "
    
    Dim cel As Range       ' Current Cell Range
    Dim cValue As Variant  ' Value in Current Cell Range
    Dim Words As Variant   ' Words Array
    Dim uLimit As Long     ' Upper Limit of Words Array
    
    For Each cel In Range(FirstCell, Cells(Rows.Count, 1).End(xlUp)).Cells
        cValue = cel.Value
        If Not IsError(cValue) And Not IsEmpty(cValue) Then
            Words = Split(cValue, Delim)
            uLimit = UBound(Words)
            Select Case uLimit
                Case 0
                    cel.Offset(, ColumnOffset + 1).Value = cValue
                    cel(, ColumnOffset).Value = ""
                Case 1
                    cel.Offset(, ColumnOffset + 1).Value _
                      = Words(uLimit - 1) & Delim & Words(uLimit)
                    cel(, ColumnOffset).Value = ""
                Case Is > 1
                    cel.Offset(, ColumnOffset + 1).Value _
                      = Words(uLimit - 1) & Delim & Words(uLimit)
                    ReDim Preserve Words(uLimit - 2)
                    cel(, ColumnOffset).Value = Join(Words, Delim)
            End Select
        End If
    Next cel

End Sub

 

[UZZY123]

Keeping the uppercase in uppercase is easy. If you will use XL2BB to post the data in your image, showing the raw data, and (manually entered) the result you want, I will try to accommodate you.

Sorry i dont know what XL2BB is.