VB question or help?

cu3edweb · 2008-12-17 21:01:26

My brother asked me for some help with a VB macro he is trying to run in excel and I was wondering if there are any VB gurus here that could help out. What he is trying to accomplish is: He has a excel file full of names that are all uppercase. He wants to have all the name converted to First letter upper and rest lower and so on, but he also needs it to account for things such as:

McDonald
VanDinter

but he also would like it to account for things such as:

LLC
LLP

for businesses.

Here is an example of what he is starting starting with and needs changed:

JOHN MCCAIN LLC

The code he has now does:

John Mccain Llc

He needs it to read:

John McCain LLC

Here is the code he has right now.

Sub Proper_case()
      '-- This macro is invoked by you -- i.e. from Macro Dialog (Alt+F8)
      Proper_Case_Inner    'The macro you invoke from a menu is Proper_Case
   End Sub
   Sub Proper_Case_Inner(Optional mySelection As String)
     Application.ScreenUpdating = False
     Application.Calculation = xlCalculationManual
     Dim cell As Range
     Dim rng As Range
     On Error Resume Next   'In case no cells in selection
     If mySelection = "" Then Set rng = Selection _
         Else Set rng = Range(mySelection)
     For Each cell In Intersect(rng, _
            rng.SpecialCells(xlConstants, xlTextValues))
        cell.Formula = StrConv(cell.Formula, vbProperCase)
        '--- this is where you would code generalized changes for lastname
        '--- applied to names beginning in position 1 of cell
        If Left(cell.Value, 3) = "Mac" _
               And Left(cell.Value, 4) <> "Mack" Then cell.Value = _
           "Mac" & UCase(Mid(cell.Value, 4, 1)) & Mid(cell.Value, 5, 99)
           '-- do not change Mack   Mackey  Mackney  or any Mack...
        If Left(cell.Value, 2) = "O'" Then cell.Value = _
           "O'" & UCase(Mid(cell.Value, 3, 1)) & Mid(cell.Value, 4, 99)
        If Left(cell.Value, 8) = "Van Den " Then cell.Value = _
            "van den  " & Mid(cell.Value, 9, 99)
        If Left(cell.Value, 8) = "Van Der " Then cell.Value = _
           "van der " & Mid(cell.Value, 9, 99)
        '-- single parts after those with two part prefixes
        If Left(cell.Value, 3) = "Vd " Then cell.Value = _
            "vd " & Mid(cell.Value, 4, 99)
        If Left(cell.Value, 4) = "V/D " Then cell.Value = _
            "v/d " & Mid(cell.Value, 5, 99)
        If Left(cell.Value, 4) = "V.D " Then cell.Value = _
            "v.d " & Mid(cell.Value, 5, 99)
        If Left(cell.Value, 3) = "De " Then cell.Value = _
           "de " & Mid(cell.Value, 4, 99)
        If Left(cell.Value, 4) = "Van " Then cell.Value = _
           "van " & Mid(cell.Value, 5, 99)
        If Left(cell.Value, 4) = "Von " Then cell.Value = _
           "von " & Mid(cell.Value, 5, 99)
     Next
     '-- some specific text changes to lowercase, not in first position
     rng.Replace what:=" a ", replacement:=" a ", _
       lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
     rng.Replace what:=" and ", replacement:=" and ", _
       lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
     rng.Replace what:=" at ", replacement:=" at ", _
       lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
     rng.Replace what:=" for ", replacement:=" for ", _
       lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
     rng.Replace what:=" from ", replacement:=" from ", _
       lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
     rng.Replace what:=" in ", replacement:=" in ", _
       lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
     rng.Replace what:=" of ", replacement:=" of ", _
       lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
     rng.Replace what:=" on ", replacement:=" on ", _
       lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
     rng.Replace what:=" the ", replacement:=" the ", _
       lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
     '--- This is where you would code specific name changes
     '--- regardless of position of character string in the cell
     rng.Replace what:="mcritchie", replacement:="McRitchie", _
       lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
     Application.Calculation = xlCalculationAutomatic
     Application.ScreenUpdating = True
     CapWords (mySelection)  'activate if you want to run macro
  End Sub
Sub CapWords(Optional mySelection As String)
    'Expect all substitutions here would be to capitals
    'not necessarily limited to words
    Dim savCalc As Long, savScrnUD As Boolean
    savCalc = Application.Calculation
    savScrnUD = Application.ScreenUpdating
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Dim rng As Range
    On Error GoTo done   'In case no cells in selection
    If mySelection = "" Then Set rng = Selection _
         Else: Set rng = Range(mySelection)
    rng.Replace what:="IBM", replacement:="IBM", _
       lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
done:
    Application.Calculation = savCalc
    Application.ScreenUpdating = savScrnUD
End Sub

Thanks

Envil · 2008-12-17 21:50:18

Id try something like this.. but keep in mind the last time i touched VB is like 2 years ago =P

Do While ( Len(s_Data) > 0 )

    If ( InStr(0, s_Data, Chr(32)) > 0 )
        s_Temp = Left(s_Data, InStr(0, s_Data, Chr(32)) - 1)
    Else
        s_Temp = s_Data
    End If


    s_Temp = LCase(s_Temp)

    If ( Len(s_Temp) <= 3 )

        s_Temp = UCase(s_Temp)        'for stuff like LLC
    
    Else If ( Left(s_Temp, 2) = "mc" )

        Mid(s_Temp, 1, 1) = "M"
        Mid(s_Temp, 3, 1) = UCase(Mid(s_Temp, 3, 1))

    Else If ( Left(s_Temp, 2) = "van" )

        Mid(s_Temp, 1, 1) = "V"
        Mid(s_Temp, 4, 1) = UCase(Mid(s_Temp, 4, 1))

    Else

        Mid(s_Temp, 1, 1) = UCase(Mid(s_Temp, 1, 1))

    End If
    

    s_Data_New = Chr(32) + s_Temp

    If ( InStr(0, s_Data, Chr(32)) > 0 )
        s_Data = substr(s_Data, InStr(0, s_Data, Chr(32)) + 1)
    Else
        s_Data = ""
    End If
Loop

cu3edweb · 2008-12-18 00:37:28

Thanks for the reply. That does not work in excel as a macro though. It errors out.

mrunion · 2008-12-18 04:34:35

Unless you just HAVE to have a macro, I'd export the sheet to a CSV, then use perl or python to run across it and do the work. Then just open the CSV and save it back as an Excel file.

Envil · 2008-12-18 09:09:47

cu3edweb wrote:

Thanks for the reply. That does not work in excel as a macro though. It errors out.

And with what kind of error? You cant just copy & paste it tho, you have to declare the variables and add a sub for it etc ^^

Arch Linux

#1 2008-12-17 21:01:26

VB question or help?

#2 2008-12-17 21:50:18

Re: VB question or help?

#3 2008-12-18 00:37:28

Re: VB question or help?

#4 2008-12-18 04:34:35

Re: VB question or help?

#5 2008-12-18 09:09:47

Re: VB question or help?

Board footer