Pastable version of Column Cleanup - Excel 2002 VBA

<pre class='prettyprint' language='asp_vb.net'>Sub cleanupSheet()
' This function asks for two input the first is the sheet you want to clean up 
' The second is the Column and cell you wish to start at, e.g. A1

Dim testRight As String
    Dim testLeft As String
    Dim stringLength As Long
    Dim endRange As String
    Dim strRange As String
    Dim inputSheetname As String
        
    inputSheetname = InputBox(Prompt:=&quot;Enter the Sheetname you want to cleanup.&quot;, _
          Title:=&quot;ENTER SHEETNAME&quot;, Default:=&quot;Group_Summary&quot;)
          
    strRange = InputBox(Prompt:=&quot;Enter the first Column/Cell.&quot;, _
          Title:=&quot;ENTER RANGE&quot;, Default:=&quot;A6&quot;)
    
    Sheets(inputSheetname).Activate
        
    ' Turn off screen updating to speed up macro.
    Application.ScreenUpdating = False

' Loop through the &quot;Sheet&quot; list and clean it up

endRange = left(strRange, 1)
    endRange =  endRange + CStr((Range(strRange, Range(strRange).End(xlDown)).Rows.count) + Right(strRange, 1))
    
    For Each x In Sheets(inputSheetname).Range(strRange, endRange)
                
        'See if we are looking at a field with a name in it
        testLeft = Left(x.Value, 1)
        If testLeft Like &quot;[a-z, A-Z]&quot; Then
            
            'Test for numbers
            testRight = Right(x.Value, 1)
            
            Do While testRight Like &quot;[0-9]&quot;
               
               stringLength = Len(x.Value)
               stringLength = stringLength - 1
               
               'Remove right most charater from cell
               x.Value = Left(x.Value, stringLength)
               testRight = Right(x.Value, 1)
            Loop
                        
            'Test for know String Values
            testRight = Right(x.Value, 3)
            If testRight = &quot; OC&quot; Then
                'Remove value from right side of cell
                stringLength = Len(x.Value)
                stringLength = stringLength - 2
                x.Value = Left(x.Value, stringLength)
            
            ElseIf testRight = &quot; NH&quot; Then
            
            'Remove value from right side of cell
                stringLength = Len(x.Value)
                stringLength = stringLength - 2
                x.Value = Left(x.Value, stringLength)
            End If
                     
        End If
        'Trim spaces from both sides of cell contents
        x.Value = Trim(x.Value)
    Next x
    
  Application.ScreenUpdating = True
MsgBox &quot;Done!&quot;
End Sub</pre>
<a href="http://www.refactormycode.com/codes/185-column-cleanup-excel-2002-vba" style="color:#fff" title="As seen on RefactorMyCode.com"><img alt="Small_logo" src="http://www.refactormycode.com/images/small_logo.gif" style="border:0" /></a>

Refactor :my => 'code'

Recent

Popular

Pastable version of Column Cleanup - Excel 2002 VBA