Pastable version of Column Cleanup - Excel 2002 VBA

<div style="overflow:auto;border:solid 1px #ccc;background:#000;color:#F8F8F8">
 <div class="section">
 
 <pre style="float:left;margin:0 10px;border-right:0;color:#666;">1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70</pre>
 <pre class="sunburst">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>
 </div>
 </div>

Refactor :my => 'code'

Recent

Popular

Pastable version of Column Cleanup - Excel 2002 VBA