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

 

[JoeMo]

I Install the add in but i cant see the mrexcel or capture range.
I am using excel 2007, not sure if that maybe the issue

Excel 2007 is OK. Do you see a MrExcel tab on the ribbon? If not, you haven't installed XL2BB correctly.

 

[JLGWhiz]

This seems to work with more than one color descriptor.

Sub t3()
Dim c As Range, spl As Variant, i As Long
    With ActiveSheet
        For Each c In Range("A1", .Cells(Rows.Count, 1).End(xlUp))
            spl = Split(c.Value, " ")
            For i = LBound(spl) To UBound(spl)
                    If Len(spl(i)) > 1 And UCase(spl(i)) = spl(i) Then
                        c.Offset(, 1) = Mid(c.Value, InStr(c.Value, spl(i)))
                        Exit For
                    End If
            Next
        Next
    End With
End Sub

TestBase.xlsm
	A	B	C	D
1	fjkd sldk fjsle fjkls RED 2	RED 2
2	fjsld kglsdk ejrkl PEA GREEN 12	PEA GREEN 12
3	fjei slei ieng oekd BLUE 8	BLUE 8
4	fjkgl dkek diels FIRE ENGINE RED 12	FIRE ENGINE RED 12
5
6
Sheet1