split and join data case sensitive

[already]

Hi

I have a large data base with 8 columns (imported from the web)
The data consists of names in uppercase and titles in propercase.
The name could be in 1,2 or 3 columns and also the titels coud be spread in more columns.

The goal is to join the uppercase words in one cell and the propercase words in another.

ex 4 columns

1/ LENNY |KRAVITZ |Black And White |America

ex 3 columns
2/ THE KOOKS | Junk Of The | Heart

should be converted in

1/ LENNY KRAVITZ | Black And White America
2/ THE KOOKS | Junk Of The Heart

etc

Thanks in advance for your help

Kind regards

Al

 

[jbeaucaire]

This macro will create your items in columns J:K

Option Explicit
Option Compare Binary   'case sensitive

Sub Reformat()
Dim LR As Long, rw As Long, BUF As String, buf2 As String
Dim RNG As Range, NmStr As Range

LR = Range("A" & Rows.Count).End(xlUp).Row
Range("J:K").ClearContents

For rw = 2 To LR
    Set RNG = Rows(rw).SpecialCells(xlConstants)
    For Each NmStr In RNG
        If NmStr = UCase(NmStr) Then
            BUF = BUF & " " & NmStr
        Else
            buf2 = buf2 & " " & NmStr
        End If
    Next NmStr
    Range("J" & rw) = Trim(BUF)
    Range("K" & rw) = Trim(buf2)
    BUF = ""
    buf2 = ""
Next rw
            
Range("J:K").Columns.AutoFit
End Sub

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K
1
2	LENNY	KRAVITZ	Black And White	America						LENNY KRAVITZ	Black And White America
3	THE KOOKS	Junk Of The	Heart							THE KOOKS	Junk Of The Heart
4	BOB	JOHN	DILLON	Only In	America					BOB JOHN DILLON	Only In America
5
6
Blad2

 

[Rick Rothstein]

Here is another macro for you to consider...

Sub CombineAllUpperCaseAndAllProperCase()
  Dim X As Long, Z As Long, LastCol As Long, Cell As Range, Upper As String, Proper As String
  Const StartRow As Long = 2
  Const FirstOuputColumn As String = "G"
  For X = StartRow To Cells(Rows.Count, "A").End(xlUp).Row
    LastCol = Cells(X, Columns.Count).End(xlToLeft).Column
    Upper = ""
    Proper = ""
    For Z = 1 To LastCol
      If Not Cells(X, Z).Value Like "*[!A-Z ]*" Then
        Upper = Upper & Cells(X, Z) & " "
      Else
        Proper = Proper & Cells(X, Z) & " "
      End If
    Next
    Cells(X, FirstOuputColumn).Value = Trim(Upper)
    Cells(X, FirstOuputColumn).Offset(, 1).Value = Trim(Proper)
  Next
End Sub

 

[already]

Hi
It did the job

Many thanks

Al

 

[mikerickson]

=trim(rept(exact(proper(a1),a1),a1)&" "&rept(exact(proper(b1),b1),b1)&" "&rept(exact(proper(C1),C1),C1)&" "&rept(exact(proper(d1),d1),d1))