Option Explicit
     Dim strText As String
     Dim preString As String
     Dim postString As String
     Dim uCount As String
     Dim lCount As String
     Dim B As Integer
     Dim i As Integer
     Dim char2 As String

Sub Main() ' Click to run script. Script Standardises Text in a column. I.e. USA Armed Forces becomes USA Armed Forces, BarRy JONES becomes Barry Jones
     Dim strText As String
     Dim cRow As Integer 'Current row
     cRow = 2
     Sheets("Main").Select 'Select the Sheet

     Do While ActiveCell > ""
         strText = ActiveCell
         strText = fProper(strText)
         Cells(cRow, 2) = strText
         cRow = cRow + 1
         Cells(cRow, 1).Select
End Sub

Function fProper(strTxt As String)
     strText = strTxt
     uCount = 0
     lCount = 0
     'Seek the first space.
     B = InStr(1, strText, " ")
     'Test if there IS a space
     If B > 0 Then
         preString = Left(strText, B - 1)
         postString = Mid(strText, B, (Len(strText) - B) + 1)
         'Cycle through the post-string;
         'at least 1 lower case character will imply that the caps lock wasn't on
         For i = 1 To Len(postString)
             Select Case Asc(Mid(postString, i, 1))
                 Case 65 To 90
                     uCount = uCount + 1
                 Case 97 To 122
                     lCount = lCount + 1
                 Case Else
            End Select
            If lCount > 0 Then Exit For 'Go no further if a lowercase character is found
        Next i
        If lCount > 0 Then
            postString = StrConv(postString, 3) '3=proper case, 2=lowercase, 1=upper case
            'If the 2nd character of the pre-string is uppercase, it is reasonable
            'to assume the entire pre-string should be too.
            char2 = Mid(preString, 2, 1)
            If Asc(char2) >= 65 And Asc(char2) <= 90 Then
                preString = StrConv(preString, 1) 'entire pre-string is upper
                preString = StrConv(preString, 3) 'pre-string is proper
            End If
            preString = StrConv(preString, 3) 'No lower case found, Caps Lock stuck;
            postString = StrConv(postString, 3) 'Reduce the entire string to proper
        End If
        fProper = preString & postString 'Add the two elements together
         'No space was found, a reasonable assumption as to case can't be made;.
         'pass the string back unaltered.
         fProper = strText
     End If
End Function
downloadDownload PNG downloadDownload JPEG downloadDownload SVG

Tip: You can change the style, width & colours of the snippet with the inspect tool before clicking Download!

Click to optimize width for Twitter