Excel VBA - Capitalise Certain Words-CodePudding

I am currently using this procedure which basically changes the capitalisation for all cells to Proper in a column and it works fine.

VBA Code:

Sub sanitise_data()

x_import.Activate

 With x_import.Range("A1", Cells(Rows.Count, "A").End(xlUp))
        .value = Evaluate("INDEX(Proper(" & .Address(External:=True) & "),)")
    End With
    
End Sub

The data is all in caps:

RUGBY UNION
WTA TOUR 500
WTA TOUR 1000
PGA TOUR CHAMPIONS
ATP 250
ATP 500
PGA TOUR
EIHL
EIHL
PREMIER LEAGUE
AEW
NHL
EUROPA LEAGUE
NHL
NHL
NBA
NHL
NHL
NBA
HARLEM GLOBETROTTERS 2022 SPREAD GAME TOUR

I am looking to add another loop to change back certain words to all CAPS such as EIHL, WTA,NHL,NBA etc.. which I can define in a VBA array perhaps. The function should be smart enough to analyse each word in each cell I presume.

CodePudding user response：

Assuming the exceptions "EIHL, WTA,NHL,NBA" as first words you might try the following using a boolean help function IsCaps() to recheck all proper conversions in a variant 2-dim datafield array data:

Sub MakeProper()
'0) First conversion to proper (by a slightly modified OP code)
    Dim rng As Range, data As Variant
    With x_import                  ' << change to any sheet Code(Name) like e.g. Sheet1,...                               
        Set rng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
        data = .Evaluate("INDEX(Proper(" & rng.Address & "),)")
    End With
'1) change exceptions to UCase
    Dim i As Long
    For i = 1 To UBound(data)
        If IsCap(data(i, 1)) Then data(i, 1) = UCase(data(i, 1))
    Next i
'2) overwrite results (or use a column offset greater 0)
    rng.Offset(, 0) = data
End Sub

Note

the point-prefix in .Cells and .Rows to reference the actually wanted sheet
the point-prefix in .Evaluate to associate the evaluation content directly to the x_import sheet (so you need not pass the External:=True argument to rng.Address, though both versions are valid).

Help function IsCap()

Function IsCap(ByVal s) As Boolean
Const Delim As String = ","
Dim Caps As Variant
    Caps = Split("Eihl,Wta,Nhl,Nba", Delim) ' << use proper writing!
IsCap = UBound(Filter(Caps, Split(s & " ")(0))) > -1
End Function