Splitting lower case from uppercase

UZZY123

New Member
Joined
Nov 9, 2020
Messages
8
Office Version
  1. 2007
Platform
  1. Windows
harinsh,


Sample raw data:


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





After the macro:


Excel Workbook
AB
1Bank of GhanaAccra
2Bank of GhanaAgona Swedru
3Bank of GhanaTakoradi
4Bank of GhanaSefwi Boako
5Barclays BankUndp
6Barclays BankTwifo Praso
7Barclays BankWa
8Rural & Community BanksAfram Rural Bank Ltd-Tease
9EcobankAccra Shopping Mall
10Amalgamated BankSpintex Road
11Fidelity BankOkaishie
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).


Code:
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
 

Attachments

  • Current Macro results.jpg
    Current Macro results.jpg
    39.3 KB · Views: 10
  • Intended Result.jpg
    Intended Result.jpg
    25.2 KB · Views: 10
  • Orginal data.jpg
    Orginal data.jpg
    37.8 KB · Views: 10

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
VBA Code:
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
Application define or object define error message i recieved :(
 
Upvote 0
Application define or object define error message i recieved :(
Sorry, fixed it. I forgot three times .Offset

VBA Code:
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.Offset(, ColumnOffset).Value = ""
                Case 1
                    cel.Offset(, ColumnOffset + 1).Value _
                      = Words(uLimit - 1) & Delim & Words(uLimit)
                    cel.Offset(, ColumnOffset).Value = ""
                Case Is > 1
                    cel.Offset(, ColumnOffset + 1).Value _
                      = Words(uLimit - 1) & Delim & Words(uLimit)
                    ReDim Preserve Words(uLimit - 2)
                    cel.Offset(, ColumnOffset).Value = Join(Words, Delim)
            End Select
        End If
    Next cel

End Sub
 
Upvote 0
VBA Code:
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
This code has three mistakes: instead of cel(, ColumnOffset).Value, cel.Offset(, ColumnOffset).Value should be used. There is an amended version posted.
 
Upvote 0
Modified:

VBA Code:
Sub t2()
Dim spl As Variant
    With ActiveSheet
        For Each c In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
            spl = Split(c.Value, " ")
            c.Offset(, 1) = UCase(spl(UBound(spl) - 1)) & " " & spl(UBound(spl))
        Next
    End With
End Sub
 
Upvote 0
just for fun with Power Query with example from post#1

RawDataList
Bank of Ghana ACCRAAccra
Bank of Ghana AGONA SWEDRUAgona Swedru
Bank of Ghana TAKORADITakoradi
Bank of Ghana SEFWI BOAKOSefwi Boako
Barclays Bank UNDPUndp
Barclays Bank TWIFO PRASOTwifo Praso
Barclays Bank WAWa
Rural & Community Banks AFRAM RURAL BANK LTD-TEASEAfram Rural Bank Ltd-Tease
Ecobank ACCRA SHOPPING MALLAccra Shopping Mall
Amalgamated Bank SPINTEX ROADSpintex Road
Fidelity Bank OKAISHIEOkaishie

Power Query:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    TT = Table.AddColumn(Source, "TT", each Text.Trim([RawData])),
    Split = Table.ExpandListColumn(Table.TransformColumns(TT, {{"TT", Splitter.SplitTextByDelimiter(" ", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "TT"),
    True = Table.AddColumn(Split, "True", each [TT]=Text.Upper([TT])),
    Filter = Table.SelectRows(True, each ([True] = true) and ([TT] <> "&")),
    Grp = Table.Group(Filter, {"RawData"}, {{"Count", each _, type table}}),
    List = Table.AddColumn(Grp, "List", each [Count][TT]),
    Extract = Table.TransformColumns(List, {"List", each Text.Combine(List.Transform(_, Text.From), " "), type text}),
    TSC = Table.SelectColumns(Extract,{"RawData", "List"}),
    Proper = Table.TransformColumns(TSC,{{"List", Text.Proper, type text}})
in
    Proper
 
Last edited:
Upvote 0
Sorry, fixed it. I forgot three times .Offset

VBA Code:
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.Offset(, ColumnOffset).Value = ""
                Case 1
                    cel.Offset(, ColumnOffset + 1).Value _
                      = Words(uLimit - 1) & Delim & Words(uLimit)
                    cel.Offset(, ColumnOffset).Value = ""
                Case Is > 1
                    cel.Offset(, ColumnOffset + 1).Value _
                      = Words(uLimit - 1) & Delim & Words(uLimit)
                    ReDim Preserve Words(uLimit - 2)
                    cel.Offset(, ColumnOffset).Value = Join(Words, Delim)
            End Select
        End If
    Next cel

End Sub
Again thank you however, the new issue is that it only works when the colour is one word. So for example Purple will work but when the colour is SKY BLUE. Only the BLUE will move over.
Also can you make it that B coloum moves to C Coloum

Thanks
 
Upvote 0
Again thank you however, the new issue is that it only works when the colour is one word. So for example Purple will work but when the colour is SKY BLUE. Only the BLUE will move over.
Also can you make it that B coloum moves to C Coloum

Thanks
Change the ColumnOffset to 1. About the colors, I have no clue how I would do it. I would have to know all colors and put them into a data structure (array, dictionary, collection...) and then... unless you know there will always be an exact number of words before the color.
 
Upvote 0
a few minutes ago i saw the xl365 on your profile but now it's xl2007 so if that's the second option ignore post#16
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,211
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top