PDA

View Full Version : A Data Cleaning Macro - Clean, Trim and CHAR(160)



Simple_One
08-21-2013, 01:41 AM
Hi All,

I'm trying to hack together a simple VBA macro that is basically analogous to the excel formula below, but which will work on the selected range of cells.
=TRIM(CLEAN(SUBSTITUTE([selected range],CHAR(160)," ")))

I found a similar piece of code for a starting point (not mine, can't find the original post to credit author now either - Sorry!), though I do not need nor want the PROPER function.
So, I've started hacking away at this piece of original starting code:

Sub CleanTrimProper()
Dim r As Range
Set r = Selection
r.Value = Evaluate("IF(ROW(" & r.Address & "),PROPER(TRIM(CLEAN(" & r.Address & "))))")
End Sub


I have to be honest though, I don't understand how this works:
" & r.Address & "

Any suggestions?
My guesses so far have failed miserably, principally because i have no idea what i'm doing :D

r.Value = Evaluate("IF(ROW(" & r.Address & "),TRIM(CLEAN(REPLACE(" & r.Address & ",CHR(160)," * "))))")
r.Value = Evaluate("IF(ROW(" & r.Address & "),REPLACE(TRIM(CLEAN(" & r.Address & ")),CHR(160),""))")
r.Value = Evaluate("IF(ROW(" & r.Address & "),TRIM(CLEAN(" & r.Address & ")))").Replace(Chr(160), "")


Cheers

snb
08-21-2013, 02:12 AM
Sub CleanTrimProper()
msgbox selection.address
msgbox "IF(ROW(" & selection.Address & "),PROPER(TRIM(CLEAN(" & selection.Address & "))))"
selection= Evaluate("IF(ROW(" & selection.Address & "),PROPER(TRIM(CLEAN(" & selection.Address & "))))")
End Sub

Now you can see what string is being entered into the method 'Evaluate'
Compare that string to the Excel formula you would like to be used. Adapt the textstring accordingly.

You can also try:

Sub M_snb()
Selection=Evaluate("Index(trim(clean(" & selection.address & ")),)")
End Sub

Simple_One
08-21-2013, 03:09 AM
Righto, i'll dive into it and get back to you. Thanks.

snb
08-21-2013, 04:00 AM
This gave me the desired result:


Sub M_snb()
Selection = Evaluate("if(" & Selection.Address & "="""","""",clean(trim(" & Selection.Address & ")))")
End Sub

Simple_One
08-21-2013, 04:04 AM
That doesn't remove my arch nemesis, ASCII 160.
Getting just the clean and trim function to work is fine, but it doesn't seem to work when i use the same methods to pass the data to the replace function....

snb
08-21-2013, 04:45 AM
Wouldn't this suffice to remove chr(160) :


Sub M_snb()
activesheet.cells.replace chr(160),""
End Sub

Did you use ?


Sub M_snb()
Selection = Evaluate("if(" & Selection.Address & "="""","""",substitute(clean(trim(" & Selection.Address & ")),char(160),""""))")
End Sub

Simple_One
08-21-2013, 05:20 AM
That does indeed work, thanks very much! :friends:

I still don't fully understand this though:
" & Selection.Address & "

Why does it need to be concatenated with leading and trailing spaces?
Doesn't Selection.Address just return a string with the cell addresses...?

snb
08-21-2013, 06:07 AM
Analogy:


msgbox "this is number " & 5 & " as you can see"

c00="this text"
msgbox "Now you can see " & c00

Simple_One
08-21-2013, 05:42 PM
Yep, copy that. I have no idea why that was confusing me last night, the old brain must have been a bit fried!

Thanks for the help snb!

Paul_Hossler
08-21-2013, 06:27 PM
If you're replacing a NBS, do you want to replace it with a regular old space chr(32)?



activesheet.cells.replace chr(160),""


Paul

Paul_Hossler
08-21-2013, 07:03 PM
I get some pretty crappy data pasted in from Word or the web or the mainframe (we still use them)

This is the 'Range Cleaner' that I use, and so far it seems to work ok for cleaning and trimming

Also added option to UC text and to keep the length within a limit




Option Explicit

'Use Clean on text imported from other applications that contains characters that may not print with your operating system.
'For example, you can use Clean to remove some low-level computer code that is frequently at the beginning and end of data
'files and cannot be printed.
'Important The Clean function was designed to remove the first 32 nonprinting characters in the 7-bit ASCII code
'(values 0 through 31) from text. In the Unicode character set, there are additional nonprinting characters
'(values 127, 129, 141, 143, 144, and 157). By itself, the Clean function does not remove these additional
'nonprinting characters

Sub Range_Clean(RangeIn As Range, Optional MakeUpperCase As Boolean = True, Optional MaxLen As Long = 255)
Const csSpace As String = " "
Dim rArea As Range, rText As Range
Dim bEvents As Boolean, bScreen As Boolean
Dim s As String

bEvents = Application.EnableEvents
bScreen = Application.ScreenUpdating

On Error GoTo NiceExit

Set rText = RangeIn.SpecialCells(xlCellTypeConstants, xlTextValues)

'replace CR, NL, and tab with space, and 127, 129, 141, 143, 144, and 157 and 160
With rText
Call .Replace(Chr(9), csSpace, xlPart)
Call .Replace(vbCrLf, csSpace, xlPart)
Call .Replace(Chr(13), csSpace, xlPart)

Call .Replace(Chr(127), csSpace, xlPart)
Call .Replace(Chr(129), csSpace, xlPart)
Call .Replace(Chr(141), csSpace, xlPart)
Call .Replace(Chr(143), csSpace, xlPart)
Call .Replace(Chr(144), csSpace, xlPart)
Call .Replace(Chr(157), csSpace, xlPart)
Call .Replace(Chr(160), csSpace, xlPart)
End With

For Each rArea In rText.Areas
With rArea
.Value = Application.Evaluate("=TRIM(" & .Address & ")")
.Value = Application.Evaluate("=CLEAN(" & .Address & ")")
.Value = Application.Evaluate("=LEFT(" & .Address & "," & MaxLen & ")")
.Value = Application.Evaluate("=TRIM(" & .Address & ")") 'in case LEFT leaves space(s) at end
If MakeUpperCase Then .Value = Application.Evaluate("=UPPER(" & .Address & ")")
End With
Next

NiceExit:
Application.EnableEvents = bEvents
Application.ScreenUpdating = bScreen
End Sub


Sub test()
Call Range_Clean(Cells(1, 1).CurrentRegion, False, 6)
End Sub



Paul

Simple_One
08-21-2013, 08:05 PM
Excellent, thanks Paul; I'll have a look at that as well.

Here's a similar one I found: (source: http://www.excelfox.com/forum/f13/trim-all-cells-in-a-worksheet-vba-155/#post1092)


Function CleanTrim(ByVal S As String, Optional ConvertNonBreakingSpace As Boolean = True) As String
Dim X As Long, CodesToClean As Variant
CodesToClean = Array(0, 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, 127, 129, 141, 143, 144, 157)
If ConvertNonBreakingSpace Then S = Replace(S, Chr(160), " ")
For X = LBound(CodesToClean) To UBound(CodesToClean)
If InStr(S, Chr(CodesToClean(X))) Then S = Replace(S, Chr(CodesToClean(X)), "")
Next
CleanTrim = WorksheetFunction.Trim(S)
End Function

I modified that and ended up with the following function and sub:


Function CleanTrimExcel(ByVal S As String, Optional ConvertNonBreakingSpace As Boolean = True) As String

Dim X As Long
Dim CodesToReplace() As Variant

If ConvertNonBreakingSpace Then
ReDim CodesToReplace(1 To 7)
CodesToReplace = Array(127, 129, 141, 143, 144, 157, 160)
Else
ReDim CodesToReplace(1 To 6)
CodesToReplace = Array(127, 129, 141, 143, 144, 157)
End If

For X = LBound(CodesToReplace) To UBound(CodesToReplace)
If InStr(S, Chr(CodesToReplace(X))) Then S = Replace(S, Chr(CodesToReplace(X)), Chr(0))
Next

CleanTrimExcel = WorksheetFunction.Trim(WorksheetFunction.Clean(S))

End Function



Sub CallCleanTrimExcel()


Dim arr() As Variant
Dim m As Double
Dim n As Double

arr = Selection.Value

For m = LBound(arr, 1) To UBound(arr, 1)
For n = LBound(arr, 2) To UBound(arr, 2)
arr(m, n) = CleanTrimExcel(arr(m, n))
Next n
Next m

Selection = arr()


End Sub

Simple_One
08-21-2013, 08:30 PM
Actually it looks like you have addressed an issue that just occurred to me, namely keeping formula cells as formulas, whilst cleaning all the cells that hold constants around them.

Can this be done using the .SpecialCells property on the selection?
I'm thinking the answer lies in getting to know these two:
http://msdn.microsoft.com/en-us/library/office/ff196157.aspx
http://msdn.microsoft.com/en-us/library/office/ff836534.aspx

The intended outcome would be that so you can select a range that is a mixture of constants and formulas, and then process that range in a way that outputs the cleaned constants and leaves the formulas untouched.

snb
08-22-2013, 01:30 AM
Why don't you use Excel's replace instead of VBA's replace ?



Sub M_snb()
sn = Array(127, 129, 141, 143, 144, 157, 160)

For j = 0 To UBound(sn)
Cells(j + 1, 4) = String(5, "a") & Chr(sn(j)) & String(8, "BB")
Next

For j = 0 To UBound(sn)
Cells.Replace Chr(sn(j)), " "
Next
Cells.Replace " ", " "
End Sub

Paul_Hossler
08-22-2013, 04:22 AM
Actually it looks like you have addressed an issue that just occurred to me, namely keeping formula cells as formulas, whilst cleaning all the cells that hold constants around them.


.SpecialCells does that, and I limit it to Constants and TextValues.

This will normally select a range with multiple blocks, so I loop through the .Areas and do it one block at a time for the WS functions

For the VBA .Replace, it seems to be smart enough to just do the text cells, but if there's a LOT of data, it MIGHT be faster to also do that inside an .Areas loop

Paul

AMontes
08-22-2013, 12:03 PM
One more:

Sub TrimALL()
'David McRitchie 2000-07-03 mod 2000-08-16 join.htm
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cell As Range
'Also Treat CHR 0160, as a space (CHR 032)
Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Trim in Excel removes extra internal spaces, VBA does not
On Error Resume Next 'in case no text cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Value = Application.trim(cell.Value)
Next cell
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Simple_One
08-25-2013, 10:55 PM
Thanks AMontes, using the Intersect function is far more elegant than anything I had come up with. Cheers!

Simple_One
08-27-2013, 06:45 PM
Well, here is what I ended up with: 1 operational sub, and two subs setup to call the operational one.

One of the callers subs sets it to operate on the selected cells, the other iterates through every worksheet and passes the used range to the function for cleaning.

In the operational sub (TrimAll):
Cleaning operations are in the form of an enumerated data type and can be employed bitwise to allow for the selection of different cleaning options. This is done using the addition operators when sending the arguments to the function (as seen in the subs).
The cleaning argument options allow for use of Excels Trim, Clean and Proper functions. The size operation just uses VBA's Left function in conjunction with an optional Length argument.
There is an argument that means that only the 'unusual characters' (CodesToReplace Array) are called, and all further cleaning is skipped.
The replacement character used can be changed, but defaults to a space (Char(32)).
There are two cases for the function. One outputs more status bar progress information than the other, but probably adds some overhead in doing so. This is the default. Whether or not this really makes a difference is beyond my level of knowledge, but I figured i would add the option to avoid any overhead if people wanted it.

Notes:
I'm not a developer, I'm just hacking things together for my purposes. As such, whilst i have tested this code it's probably not very robust.
If someone who really knows what they are doing would like to polish it, test it rigorously, optimize it or add error checking etc then please do as I have just modded the code and concepts provided by people in this thread.
If you do, I would ask that:
1. You post a link to your improved code in this thread though so I can find it!
2. You add a comment in your code with a link to this thread so that people can see the contributors of the original code and ideas.


Option Explicit

' An enumeration to allow for bitwise option selection - uses base 2, aka: binary
Enum CleanType
Size = 2 ^ 0
TextToNum = 2 ^ 1
Trim = 2 ^ 2
Clean = 2 ^ 3
Proper = 2 ^ 4
End Enum




Public Sub TrimAll(RangeIn As Range, Optional CleaningMode As CleanType = 12, Optional ReplaceOnly As Boolean = False, _
Optional Length As Integer = 255, Optional ReplacementCode As Integer = 32, Optional bCompleteStatus As Boolean = True)

Dim Cell As Range, IntersectRng As Range
Dim Index As Integer
Dim CurrentProgressValue As Double, NumCells As Double, NumCellRanges As Double
Dim CodesToReplace() As Variant



Select Case bCompleteStatus

' A version that requires more calculation, but provides more feedback to the user through the status bar.
Case True

' Reinitialise the progress variable for status bar message
CurrentProgressValue = 0
' Initialise character codes to be replaced
CodesToReplace() = Array(127, 129, 141, 143, 144, 157, 160)

For Index = LBound(CodesToReplace) To UBound(CodesToReplace)

' Display progress information in status bar
Application.StatusBar = "Currently on worksheet: """ & ActiveSheet.Name & """ - Replacement in Progress: """ & CurrentProgressValue & " of " & UBound(CodesToReplace) & ": " & Format(CurrentProgressValue / UBound(CodesToReplace), "Percent") & """ - Macro Is Still Running!"

' Convert all extra codes to the ReplacementCode character for trimming by other functions or other means in Excel
RangeIn.Replace What:=Chr(CodesToReplace(Index)), Replacement:=Chr(ReplacementCode), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
On Error Resume Next 'in case no text cells in selection

' Iterate the progress counter
CurrentProgressValue = CurrentProgressValue + 1

Next Index

' Display progress information in status bar
NumCells = RangeIn.Cells.count
If NumCells > 100000 Then
Application.StatusBar = "Currently on worksheet: """ & ActiveSheet.Name & """ - Calculating which cells are text values out of the " & Format(NumCells, "#,##0") & _
" that were passed for further processing - This might take some time, but THE MACRO IS STILL RUNNING!"
Else
Application.StatusBar = "Currently on worksheet: """ & ActiveSheet.Name & """ - Calculating which cells are text values for further processing - Macro Is Still Running!"
End If

' Reinitialise the progress variable for status bar message
CurrentProgressValue = 0
Set IntersectRng = Intersect(RangeIn, RangeIn.SpecialCells(xlConstants, xlTextValues))
NumCellRanges = IntersectRng.Cells.count

' Allow system to do events to aid stability if the passed cell range is larger than some amount
If NumCells > 100000 Then
DoEvents
End If

If Not ReplaceOnly Then
For Each Cell In IntersectRng

' Stop every X number of cells and hand over control to system to execute commands - to aid in stability and progress count
If CurrentProgressValue Mod 50000 = 0 Then
' Allow system to do events, then get VBA to wait for some number of seconds to aid stability
DoEvents
' Uncomment the line below to add wait time if required, the current config adds one second of wait time.
'Application.Wait (Now() + CDate("00:00:01"))
End If

' Display progress information in status bar every so often as determined by calculation.
If CurrentProgressValue Mod 5000 = 0 Then
Application.StatusBar = "Currently on worksheet: """ & ActiveSheet.Name & """ - Cleaning in Progress: """ & CurrentProgressValue & " of " & NumCellRanges & ": " & Format(CurrentProgressValue / NumCellRanges, "Percent") & """ - Macro Is Still Running!"
End If

If CleaningMode And Size Then
Cell.Value = Left(Cell.Value, Length)
End If
If CleaningMode And TextToNum Then
Cell.Value = Cell.Value * 1
End If
If CleaningMode And Trim Then
Cell.Value = Application.WorksheetFunction.Trim(Cell.Value)
End If
If CleaningMode And Clean Then
Cell.Value = Application.WorksheetFunction.Clean(Cell.Value)
End If
If CleaningMode And Proper Then
Cell.Value = Application.WorksheetFunction.Proper(Cell.Value)
End If

' Iterate the progress counter
CurrentProgressValue = CurrentProgressValue + 1

Next Cell
End If


' A version that requires minimal calculation to track progress, but provides less feedback to the user from the status bar.
Case False

' Initialise character codes to be replaced
CodesToReplace = Array(127, 129, 141, 143, 144, 157, 160)

' Display general information in status bar
Application.StatusBar = "Currently on worksheet: """ & ActiveSheet.Name & """ - Replacement in progress - Macro Is Still Running!"

For Index = LBound(CodesToReplace) To UBound(CodesToReplace)
' Convert all extra codes to the ReplacementCode character for trimming by other functions or other means in Excel
RangeIn.Replace What:=Chr(CodesToReplace(Index)), Replacement:=Chr(ReplacementCode), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
On Error Resume Next 'in case no text cells in selection
Next Index

' Allow system to do events to aid stability
DoEvents

' Display general information in status bar
Application.StatusBar = "Currently on worksheet: """ & ActiveSheet.Name & """ - Cleaning in progress - Macro Is Still Running!"

Set IntersectRng = Intersect(RangeIn, RangeIn.SpecialCells(xlConstants, xlTextValues))

If Not ReplaceOnly Then
For Each Cell In IntersectRng
If CleaningMode And Size Then
Cell.Value = Left(Cell.Value, Length)
End If
If CleaningMode And TextToNum Then
Cell.Value = Cell.Value * 1
End If
If CleaningMode And Trim Then
Cell.Value = Application.WorksheetFunction.Trim(Cell.Value)
End If
If CleaningMode And Clean Then
Cell.Value = Application.WorksheetFunction.Clean(Cell.Value)
End If
If CleaningMode And Proper Then
Cell.Value = Application.WorksheetFunction.Proper(Cell.Value)
End If
Next Cell
End If

End Select


End Sub




Public Sub Call_TrimAll_Selection()
'uses bitwise (base 2) enumerated CleanType data type, so options can be added together


Dim bStatusBar As Boolean

' store state of status bar, and then show it so progress of function can be seen
bStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True

' prep for long macro to run
Application.Cursor = xlWait
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Call TrimAll(Selection, Clean + Trim)

'Clear the status bar and restore its original state.
Application.StatusBar = False
Application.DisplayStatusBar = bStatusBar

' Restore after long macro
Application.ScreenUpdating = True
Application.Cursor = xlDefault
Application.Calculation = xlCalculationAutomatic
Application.CalculateFullRebuild

End Sub




Public Sub Call_TrimAll_Workbook()
'uses bitwise (base 2) enumerated CleanType data type, so options can be added together

Dim Cell As Range, OriginalCell As Range, WSCell As Range
Dim CodesToReplace() As Integer, Index As Integer, CurrentProgressValue As Integer
Dim WS As Worksheet, OriginalWS As Worksheet
Dim bStatusBar As Boolean

' store state of status bar, and then show it so progress of function can be seen
bStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True

' prep for long macro to run
Application.Cursor = xlWait
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

' Store the original position prior to running
Set OriginalCell = ActiveCell
Set OriginalWS = ActiveSheet

For Each WS In Worksheets

WS.Activate
Set WSCell = ActiveCell
Range("A1").Select
Range(Selection, Selection.SpecialCells(xlLastCell)).Select

Call TrimAll(Selection, Clean + Trim)

WSCell.Select

' Allow system to do events, then get VBA to wait for some number of seconds to aid stability
DoEvents
Application.Wait (Now() + CDate("00:00:01"))

Next WS

OriginalWS.Activate
OriginalCell.Select

'Clear the status bar and restore its original state.
Application.StatusBar = False
Application.DisplayStatusBar = bStatusBar

' Restore after long macro
Application.ScreenUpdating = True
Application.Cursor = xlDefault
Application.Calculation = xlCalculationAutomatic
Application.CalculateFullRebuild

End Sub

Paul_Hossler
08-27-2013, 07:14 PM
small comment -- Cell below is typed as a variant, although you would think it should be a Range like IntersectRng



Dim Cell, IntersectRng As Range



Have to be wordy



Dim Cell As Range, IntersectRng As Range
Dim CodesToReplace() As Long, Index As Long
Dim CurrentProgressValue As Double, NumCells As Long, NumCellRanges As Double



You made this a Function but you don't actually return anything to the function, but update RangeIn


[
Function TrimAll(RangeIn As Range, Optional CleaningMode As CleanType = 12, Optional ReplaceOnly As Boolean = False, _
Optional Length As Integer = 255, Optional ReplacementCode As Integer = 32, Optional bCompleteStatus As Boolean = True)



My preference would be to make it a Sub




Ppaul

Simple_One
08-27-2013, 07:49 PM
Ah, thanks Paul, I'll change the dims now.
I've revisited this whole data cleaning concept a few times in this process, at one stage I had a flag that would set the function to return an array of results so that you could use it within Excel, I just forgot to change it back. I'll edit the above code to a sub. I can always revisit the idea of altering it to work as a function.

Righto, I think I've corrected it all, also corrected the progress calc (CurrentProgressValue) to work without option base 1, which i had been using.

Paul_Hossler
08-27-2013, 08:11 PM
A few other ideas / thoughts to consider (not tested, but at least no errors)

1. There was a lot of duplicate code, so you could restructure a bit
2. I wouldn't rely on Activesheet. You could use RangeIn.Parent.Name to get the sheet name for the range
3. I like to use Exit Sub to avoid a lot of nested If statement if possible
4. Good idea in your sub to have DoEvents and Statusbar updates. You could combine both and what I like to do is update the statusbar whenever I have a full percent change (9% to 10% to 11% ...)




Option Explicit

' An enumeration to allow for bitwise option selection - uses base 2, aka: binary
Enum CleanType
ReplaceOnly = 0
Size = 1
TextToNum = 2
Trim = 4
Clean = 8
Proper = 16
End Enum

Sub TrimAll(RangeIn As Range, Optional CleaningMode As CleanType = ReplaceOnly, Optional ReplaceOnly As Boolean = False, _
Optional Length As Long = 255, Optional ReplacementCode As Long = 32, Optional bCompleteStatus As Boolean = True)

Dim Cell As Range, IntersectRng As Range
Dim CodesToReplace() As Long, i As Long ' Index is VBA word PH
Dim CurrentProgressValue As Double, NumCells As Long, NumCellRanges As Double
Dim CheckValue As Long


' Initialise character codes to be replaced
CodesToReplace = Array(127, 129, 141, 143, 144, 157, 160)

For i = LBound(CodesToReplace) To UBound(CodesToReplace)

' Display progress information in status bar
Application.StatusBar = "Currently on worksheet: '" & RangeIn.Parent.Name & _
"' - Replacement in Progress: " & i & " of " & UBound(CodesToReplace) & _
": " & Format(i / UBound(CodesToReplace), "Percent") & _
"' - Macro Is Still Running!"

RangeIn.Replace What:=Chr(CodesToReplace(i)), Replacement:=Chr(ReplacementCode), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Next i

If CleaningMode = ReplaceOnly Then Exit Sub

Set IntersectRng = Intersect(RangeIn, RangeIn.SpecialCells(xlConstants, xlTextValues))

If IntersectRng Is Nothing Then Exit Sub

NumCellRanges = IntersectRng.Cells.Count

CurrentProgressValue = 0
CheckValue = 0

For Each Cell In IntersectRng
With Cell
If CleaningMode And Size Then .Value = Left(.Value, Length)
If CleaningMode And TextToNum Then If IsNumeric(.Value) Then .Value = .Value * 1
If CleaningMode And Trim Then .Value = Application.WorksheetFunction.Trim(.Value)
If CleaningMode And Clean Then .Value = Application.WorksheetFunction.Clean(.Value)
If CleaningMode And Proper Then .Value = Application.WorksheetFunction.Proper(.Value)

'maybe only update on a full percent change
If CheckValue <> CLng(100 * CurrentProgressValue / NumCellRanges) Then
CheckValue = CLng(100 * CurrentProgressValue / NumCellRanges)

Application.StatusBar = "Currently on worksheet: '" & _
RangeIn.Parent.Name & "' - Cleaning in Progress: '" _
& CurrentProgressValue & " of " & NumCellRanges & ": " & _
Format(CheckValue, "#0\%") & "' - Macro Is Still Running!"
DoEvents
End If

' Iterate the progress counter
CurrentProgressValue = CurrentProgressValue + 1
End With
Next Cell

End Sub




Like I said, not tested with real data, but maybe some ideas you could use. When you're done, post the final result so I can include it in my cleanup

Paul

Simple_One
08-27-2013, 08:42 PM
Righto, I'll have a look at some of those suggestions in due course and get back to you.

Thanks again for your help Paul :)

EDIT: Okay, so, I still have a lot to learn based on how much you whittled that code down by! :think:

Simple_One
08-28-2013, 01:31 AM
So I bounced into another problem, that is, creating violations of Data Validation rules as VBA goes about it's cleaning and replacing etc, thus resulting in an overflow error.
I've decided the best approach was to calculate a complement set from the range object representing the constants, and the range of object containing the cells that have validation (each of which is calculated as per prior code, that is, from the intersection of RangeIn with .specialcells [constants,text] and RangeIn with specialcells [all validation] property).
These two threads have proved fruitful regarding how to calculate a complement set (given VBA's lack of a native function):
http://stackoverflow.com/questions/16097144/vba-difference-between-two-ranges/17510237#17510237
http://dailydoseofexcel.com/archives/2007/08/17/two-new-range-functions-union-and-subtract/

So far I've just pilfered the code from the post below and implemented it:
http://stackoverflow.com/a/17510237/2724551

I haven't tested it rigorously but it seems to work. If anyone wants to throw in some advice on the efficiency of calculating a complement set it would be appreciated, as crunching even just the original intersect using the native function takes a significant portion of the total time...

The general scheme is to use a simple boolean flag passed as an argument, that determines whether cells with validation are excluded from calculating the range that will have cleaning operations conducted on it.

Simple_One
08-28-2013, 01:53 AM
Argh, the overflow errors are more general, they're coming from something to do with applying excels clean function to numbers that have been stored as text.... Any ideas?
The overflow error comes when .trim is called to act on a cell that was a number stored as text, but the prior .clean operation causes it to display as ############# and seems to have deleted the leading zero...

In my case I don't explicitly need to convert these numbers stored as text (they're mobile phone numbers) to numbers, but how can i avoid the overflow error?
Would the answer lie in storing the cell format prior to cleaning and then reapplying it between each cleaning operation and afterwards, or some such? (that seems horribly computationally inefficient, but I'm clutching at straws)....

snb
08-28-2013, 02:24 AM
Since you didn't post a sample workbook nor indciated which code you are using it's purely guessing...
How can we be able to help you in such a case ?

Simple_One
08-28-2013, 02:43 AM
Fair point. I can't publish the workbook unfortunately, but I can probably recreate the problem in an example. The code is still evolving, I'll post it along with the example workbook once it's created.

EDIT: I worked out the problem, its not the data validation (though I now have a way round that should I ever need it) that was just a coincidence :banghead:.
The problem is that after either the trim or clean operation has been completed, the cell format is being converting those numbers with a leading zero from text, back to a 'number'.
That is then giving the next function call (either trim or clean) a big headache. All other non-text constant cells get filtered out at the start when calculating the range, the problem is these ones are getting dynamically created part way through cleaning and then subsequent functions error trying to work on a cell that is not a constant with a text value.
I haven't actually worked out what I'm going to do about it as yet, as I actually want to keep these as numbers stored as text, so that means skipping these types of cells, but ID'ing them isn't straight forward (at least no computationally efficient method that I can think of).

Simple_One
08-28-2013, 06:23 AM
Okay, sorted it out.
Basically, for reasons that are unknown to me, cells that were 'numbers stored as text' but formatted in Excel as 'Dates' rather than as 'Text'; were still getting picked up by the following bit of code:

RangeIn.SpecialCells(xlConstants, xlTextValues)
When one of these cells was encountered, as soon as it was trimmed or cleaned, it would automatically revert to being a 'number' rather than 'numbers stored as text'; naturally this caused errors with the following function calls on a cell that is no longer an xlConstants, xlTextValues cell.
My solution isn't elegant, basically what it does is change the format of all cells within the calculated IntersectRng, to text (via IntersectRng.NumberFormat = "@"). The rest of the code then works again. This may or may not be acceptable for others, but that's where I have left it at.

I've left in the functionality to skip data validation cells, though it doesn't actually seem to be a problem to clean and trim them (as I originally thought). Note that if you skip cells with data validation, this is dependent on other code that I sourced from the previous links (the codes provides a function to calculate a complement range when given two range arguments). I have reposted this code below, but it's nothing of mine, I just whacked it in and used it.
In summary: you only need the extra functions if you set the SkipValidation argument to True; if that is left as False, the extra functions are not called. The extra functions are:
Public Function Complement
Public Function Union

So here is the main cleaning code as it currently stands:

Option Explicit

' An enumeration to allow for bitwise option selection - uses base 2, aka: binary
Enum CleanType
ReplaceItOnly = 0
SizeIt = 2 ^ 0
TextToNumIt = 2 ^ 1
TrimIt = 2 ^ 2
CleanIt = 2 ^ 3
ProperIt = 2 ^ 4
PrefixCharIt = 2 ^ 5
FormatIt = 2 ^ 6
End Enum




Public Sub TrimAll(RangeIn As Range, Optional CleaningMode As CleanType = 76, Optional Length As Integer = 255, Optional ReplacementCode As Integer = 42, Optional SkipValidation As Boolean = False)


Dim Cell As Range, IntersectRng As Range, ValidationRng As Range, TextConstRng As Range
Dim i As Integer
Dim CurrentProgressValue As Double, CountCellsInRanges As Double, CheckValue As Double, PercentChange As Double
Dim CodesToReplace() As Variant
Dim temp As String


On Error GoTo STOPPER


' Initialise character codes to be replaced
CodesToReplace() = Array(127, 129, 141, 143, 144, 157, 160)


For i = LBound(CodesToReplace) To UBound(CodesToReplace)
' Display progress information in status bar
Application.StatusBar = "Currently on worksheet: """ & RangeIn.Parent.Name & """ - Replacement in Progress: """ & i & " of " & UBound(CodesToReplace) & ": " & Format(i / UBound(CodesToReplace), "Percent") & """ - Macro Is Still Running!"
' Convert all extra codes to the ReplacementCode character for trimming by other functions or other means in Excel
RangeIn.Replace What:=Chr(CodesToReplace(i)), Replacement:=Chr(ReplacementCode), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
' On Error Resume Next 'in case no text cells in selection
Next i


' If no further cleaning has been specified
If CleaningMode And ReplaceItOnly Then Exit Sub


' Display progress information in status bar
Application.StatusBar = "Currently on worksheet: """ & ActiveSheet.Name & """ - Calculating which cells are text values out of the " & Format(RangeIn.Cells.count, "#,##0") & _
" that were passed for further processing - This might take some time, but THE MACRO IS STILL RUNNING!"


' Set the intersection range, deciding whether or not to include cells with validation that may be violated.
If SkipValidation Then
Set ValidationRng = Intersect(RangeIn, RangeIn.SpecialCells(xlCellTypeAllValidation))
Set TextConstRng = Intersect(RangeIn, RangeIn.SpecialCells(xlConstants, xlTextValues))
Set IntersectRng = Complement(TextConstRng, ValidationRng)
Else
Set IntersectRng = Intersect(RangeIn, RangeIn.SpecialCells(xlConstants, xlTextValues))
End If


' No cells were found containing constants of type a text value type, so exit
If IntersectRng Is Nothing Then Exit Sub


' Set all cell formats to confirm they will stay as text throughout
' .SpecialCells(xlConstants, xlTextValues) seems to be selecting cells that are formatted as 'Date'
If CleaningMode And FormatIt Then IntersectRng.NumberFormat = "@"


' Initialise the required counter variables
CountCellsInRanges = IntersectRng.Cells.count
CurrentProgressValue = 0
CheckValue = 0


For Each Cell In IntersectRng


With Cell
' Perform the CleaningMode operations.
If CleaningMode And SizeIt Then .Value = Left(.Value, Length)
If CleaningMode And PrefixCharIt Then .Value = .Value
If CleaningMode And TextToNumIt Then .Value = .Value * 1
If CleaningMode And TrimIt Then .Value = Application.WorksheetFunction.Trim(.Value)
If CleaningMode And CleanIt Then .Value = Application.WorksheetFunction.Clean(.Value)
If CleaningMode And ProperIt Then .Value = Application.WorksheetFunction.Proper(.Value)
End With


' Only update on a full percent change
PercentChange = 100 * CurrentProgressValue \ CountCellsInRanges
If CheckValue <> PercentChange Then
CheckValue = PercentChange
Application.StatusBar = "Currently on worksheet: '" & RangeIn.Parent.Name & "' - Cleaning in Progress: '" _
& CurrentProgressValue & " of " & CountCellsInRanges & ": " & _
Format(CheckValue, "#0\%") & "' - Macro Is Still Running!"
End If

' Stop every 10% for system event execution
If CheckValue Mod 10 = 0 Then
DoEvents
End If


' Iterate the progress counter
CurrentProgressValue = CurrentProgressValue + 1


Next Cell


STOPPER:
MsgBox "Error encountered, debugging needed."
Exit Sub


End Sub




Public Sub Call_TrimAll_Selection()
'uses bitwise (base 2) enumerated CleanType data type, so options can be added together


Dim bStatusBar As Boolean


' store state of status bar, and then show it so progress of function can be seen
bStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True


' prep for long macro to run
Application.Cursor = xlWait
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


Call TrimAll(Selection)


'Clear the status bar and restore its original state.
Application.StatusBar = False
Application.DisplayStatusBar = bStatusBar


' Restore after long macro
Application.ScreenUpdating = True
Application.Cursor = xlDefault
Application.Calculation = xlCalculationAutomatic
Application.CalculateFullRebuild


End Sub




Public Sub Call_TrimAll_Workbook()
'uses bitwise (base 2) enumerated CleanType data type, so options can be added together


Dim Cell As Range, OriginalCell As Range, WSCell As Range
Dim CodesToReplace() As Integer, i As Integer, CurrentProgressValue As Integer
Dim WS As Worksheet, OriginalWS As Worksheet
Dim bStatusBar As Boolean


' store state of status bar, and then show it so progress of function can be seen
bStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True


' prep for long macro to run
Application.Cursor = xlWait
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


' Store the original position prior to running
Set OriginalCell = ActiveCell
Set OriginalWS = ActiveSheet


For Each WS In Worksheets


WS.Activate
Set WSCell = ActiveCell
Range("A1").Select
Range(Selection, Selection.SpecialCells(xlLastCell)).Select


Call TrimAll(Selection)


WSCell.Select


' Allow system to do events, then get VBA to wait for some number of seconds to aid stability
DoEvents
Application.Wait (Now() + CDate("00:00:01"))


Next WS


OriginalWS.Activate
OriginalCell.Select


'Clear the status bar and restore its original state.
Application.StatusBar = False
Application.DisplayStatusBar = bStatusBar


' Restore after long macro
Application.ScreenUpdating = True
Application.Cursor = xlDefault
Application.Calculation = xlCalculationAutomatic
Application.CalculateFullRebuild


End Sub

And here are the extra functions (not mine originally, or even modded by me) to allow for the SkipValidation functionality:

'(needed by the 2nd function)Public Function Union(ByRef rng1 As Range, _
ByRef rng2 As Range) As Range
If rng1 Is Nothing Then
Set Union = rng2
Exit Function
End If
If rng2 Is Nothing Then
Set Union = rng1
Exit Function
End If
If Not rng1.Worksheet Is rng2.Worksheet Then
Exit Function
End If
Set Union = Application.Union(rng1, rng2)
End Function






Public Function Complement(ByRef rng1 As Range, _
ByRef rng2 As Range) As Range
Dim rngResult As Range
Dim rngResultCopy As Range
Dim rngIntersection As Range
Dim rngArea1 As Range
Dim rngArea2 As Range
Dim lngTop As Long
Dim lngLeft As Long
Dim lngRight As Long
Dim lngBottom As Long


If rng1 Is Nothing Then
Exit Function
End If
If rng2 Is Nothing Then
Set Complement = rng1
Exit Function
End If
If Not rng1.Worksheet Is rng2.Worksheet Then
Exit Function
End If
Set rngResult = rng1
For Each rngArea2 In rng2.Areas
If rngResult Is Nothing Then
Exit For
End If
Set rngResultCopy = rngResult
Set rngResult = Nothing
For Each rngArea1 In rngResultCopy.Areas
Set rngIntersection = Application.Intersect(rngArea1, rngArea2)
If rngIntersection Is Nothing Then
Set rngResult = Union(rngResult, rngArea1)
Else
lngTop = rngIntersection.row - rngArea1.row
lngLeft = rngIntersection.Column - rngArea1.Column
lngRight = rngArea1.Column + rngArea1.Columns.count - rngIntersection.Column - rngIntersection.Columns.count
lngBottom = rngArea1.row + rngArea1.Rows.count - rngIntersection.row - rngIntersection.Rows.count
If lngTop > 0 Then
Set rngResult = Union(rngResult, rngArea1.Resize(lngTop, rngArea1.Columns.count))
End If
If lngLeft > 0 Then
Set rngResult = Union(rngResult, rngArea1.Resize(rngArea1.Rows.count - lngTop - lngBottom, lngLeft).Offset(lngTop, 0))
End If
If lngRight > 0 Then
Set rngResult = Union(rngResult, rngArea1.Resize(rngArea1.Rows.count - lngTop - lngBottom, lngRight).Offset(lngTop, rngArea1.Columns.count - lngRight))
End If
If lngBottom > 0 Then
Set rngResult = Union(rngResult, rngArea1.Resize(lngBottom, rngArea1.Columns.count).Offset(rngArea1.Rows.count - lngBottom, 0))
End If
End If
Next rngArea1
Next rngArea2
Set Complement = rngResult
End Function

snb
08-28-2013, 07:50 AM
I'd be more interested in a sample workbook.

Simple_One
08-28-2013, 06:18 PM
Okay attached is a small example that produces the errors I'm aware of, with some comments on the results.
The code is slightly updated from what I posted above.

The data cleaning code is in one module, and the range complement is in another if people want to play around with skipping data validation.
Cell D3 has data validation on it, but both of the cells with red fill produce an overflow error due to their format as 'date'. As mentioned, my solution is change their format to text.

One obvious thing to resolve is implement some sort of error handling if it encounters an empty worksheet, at the moment it errors with 'no cells were found'. It needs some of way of just exiting the sub and then carrying on with the next sheet if there is one in the calling sub.

EDIT: I suppose you could do some conditional checking in the calling sub to skip empty worksheets, rather than passing it to the cleaning sub to deal with....

SamT
08-28-2013, 06:41 PM
@ Not so Simple_One

When you get this project polished, why don't you submit it to Potential KB Entries (http://www.vbaexpress.com/forum/forumdisplay.php?27-Potential-KB-Entries)

SamT
08-28-2013, 06:45 PM
@ Not so Simple_One

When you get this project polished, why don't you go to the VBAX Code Submissions (http://www.vbaexpress.com/forum/forumdisplay.php?7-VBAX-Code-Submissions) forum and submit it to Potential KB Entries (http://www.vbaexpress.com/forum/forumdisplay.php?27-Potential-KB-Entries) sub forum.

Simple_One
08-29-2013, 12:51 AM
Hi SamT, I can do that. Still a fair bit of work to go to make it robust and as fast as possible though.

@Paul_Hossler
I had a specific query for you. The reason I didn't adopt your method of looping areas (which sounds like it should be faster than looping cells as I have done), is because when I use your code from page 1, whenever it encounters a range (rather than a single cell) it overwrites the entire range with the value from the first cell.
Is this a problem you have encountered before, or have I managed to do something strange to your code that I'm playing with?

snb
08-29-2013, 01:30 AM
I managed to 'clean' your example using:


Sub M_snb()

With Sheets("Example").UsedRange
.Replace Chr(10), "", xlPart
.Replace Chr(160), "", xlPart

.Name = "snb_001"
.Value = [index(trim(snb_001),)]
.Value = [if(snb_001="","",if(column(snb_001)=4,if(isnumber(snb_001),text(snb_001,"'0000000000"),snb_001),snb_001))]
End With

End Sub

Simple_One
08-29-2013, 01:42 AM
Thanks, snb, I'll have a look.

Any idea's about how to:
1. Detect pivot tables in a worksheet, and then skip to the next worksheet?
2. Detect a worksheet that contains no .SpecialCells(xlConstants, xlTextValues), and then skip to the next worksheet?

Thanks.

snb
08-29-2013, 01:48 AM
sub M_snb()
on error resume next

for each sh in sheets
if sh.pivottables.count=0 then
n=sh.specialcells(2).count
if err.number =0 then
sh.Columns(4).NumberFormat = "@"

With Sh.UsedRange
.Replace Chr(10), "", xlPart
.Replace Chr(160), "", xlPart

.Name = "snb_001"
.Value = [index(trim(snb_001),)]
End With
end if
err.clear
end if
next
End Sub

NB. The 'problems' in column D were caused by the incorrect numberformatting.

Simple_One
08-29-2013, 02:11 AM
Okay, thanks. Error handling is something I'm new to, but in your code above, does it essentially work by saying:

On Error Resume Next >>> Just keep going and execute the next line of code
{this means you can do anything that won't be affected by whatever the error may have been}
When the error might be relevant, you check Err.Number and then decide to skip some code...(or run different code etc)
Then you clear the error on your way out.

Is that about the gist of it?

snb
08-29-2013, 03:07 AM
There's probably a fine explanation in the VBEditor's helpfiles.

Simple_One
08-29-2013, 03:17 AM
Hmmm, never realised VB's help was different to Excels :dunno
I'll give it a look see.

snb
08-29-2013, 04:18 AM
It's a different program.

Simple_One
08-29-2013, 05:07 AM
That it is, thanks for pointing that out, the explanation on error handling was helpful.
Thanks also for the index idea, I'm playing around with using that do things by area as Paul suggested, rather than by cell and that seems to avoid the problem of overwriting values in a range with that of only the first cell. It does seem slow though, i presume that's down to the overheads of how index works....

Question: In your short piece of code for the example sheet

Sub M_snb()
With Sheets("Example").UsedRange
.Replace Chr(10), "", xlPart
.Replace Chr(160), "", xlPart

.Name = "snb_001"
.Value = [index(trim(snb_001),)]
.Value = [if(snb_001="","",If(column(snb_001)=4,If(isnumber(snb_001),text(snb_001,"'0000000000"),snb_001),snb_001))]
End With

End Sub

If you reverse the sequence of the replacement (replace char 160 and then char10), you get a slightly different result. Your arrangement works perfectly, but doing 160 first then 10 results in the data in the cell being slightly offset from centre, even after the trim and clean function have run. Any idea what's going on there?


Sub M_snb()
With Sheets("Example").UsedRange
' inverse sequence of original code
.Replace Chr(160), "", xlPart
.Replace Chr(10), "", xlPart

.Name = "snb_001"
.Value = [index(trim(snb_001),)]
.Value = [if(snb_001="","",If(column(snb_001)=4,If(isnumber(snb_001),text(snb_001,"'0000000000"),snb_001),snb_001))]
End With

End Sub

snb
08-29-2013, 05:30 AM
I hope you saw the amended code I posted without this line:


.Value = [if(snb_001="","",If(column(snb_001)=4,If(isnumber(snb_001),text(snb_001,"'0000000000"),snb_001),snb_001))]

Paul_Hossler
08-29-2013, 05:35 AM
@Paul_Hossler
I had a specific query for you. The reason I didn't adopt your method of looping areas (which sounds like it should be faster than looping cells as I have done), is because when I use your code from page 1, whenever it encounters a range (rather than a single cell) it overwrites the entire range with the value from the first cell.
Is this a problem you have encountered before, or have I managed to do something strange to your code that I'm playing with?



Score:

Simple_One = 1
Paul = 0


Yea, you have to (for some reason) use the IF, and (my very bad) forgot that




Option Explicit
Sub Oops()
Dim r1 As Range
Dim s As String


ActiveSheet.Range("A1:Z26").Value = "asdfasdf"


Set r1 = ActiveSheet.Cells(1, 1).SpecialCells(xlCellTypeConstants, xlTextValues)
MsgBox r1.Cells.Count



With r1

s = "=IF(" & .Address & "="""","""",UPPER(" & .Address & "))"
MsgBox s

.Value = Application.Evaluate("=IF(" & .Address & "="""","""",UPPER(" & .Address & "))")
End With

End Sub



If you still want to play with the .Areas loop, you'll have to use the .Value = above

Paul

Simple_One
08-29-2013, 06:19 AM
@snb
Yep, I saw that. What I was talking about in post #40 is unrelated to that line of code. I'm talking about cell A3 (it has a Char(10) and Char(160) in it), if you watch it closely after switching the order of the replace operations, the outcome is different.
Thanks for your second piece code, it's given me some ideas on how to implement error handling and check for undesirable conditions (which I still have to implement though, haven't started on that as yet).

@Paul
I did try doing the replacement operations by looping through the .Areas, but it was much slower that way than just letting it do the replacement across the entire OperationsRng each time.

@All
Below is a version of code that works by areas, using the index method that snb demonstrated. I've been playing with applying this to my example workbook.
I moved the clean operation (and replicated the entire loop) to above the replacement operation - this fixed the weird outcome in cell A3. Really strangely though, it prevents the overflow error on the trim operation that I started waffling on about a while back. Even if you do not reformat the cells to text, the clean operation turns D3 and D4 to hashes, just as before, but when it comes time to TRIM them, it just works, no overflow error!
I'm assuming its something to do with how index traps errors, or maybe it's to do with using named ranges, rather than .Value in individual cells....

I've been calling the code below using: Public Sub Call_TrimAll_SimpleWorkbook()
EDIT: Sorry about the messy code, I have a few different things on the go and I'm leaving the odd unused variable in by mistake or stupid comments etc.


Option Explicit

' An enumeration to allow for bitwise option selection - uses base 2, aka: binary
Enum CleanType
SizeIt = 2 ^ 0
TextToNumIt = 2 ^ 1
TrimIt = 2 ^ 2
CleanIt = 2 ^ 3
ProperIt = 2 ^ 4
PrefixCharIt = 2 ^ 5
FormatIt = 2 ^ 6
End Enum






Public Sub TrimAll(RangeIn As Range, Optional CleaningMode As CleanType = 76, Optional Length As Integer = 255, Optional ReplacementCode As Integer = 0, Optional ExcludeValidationCells As Boolean = False)


Dim Cell As Range, Area As Range, OperationsRng As Range, ValidationRng As Range, TextConstRng As Range
Dim i As Integer
Dim CurrentProgressValue As Double, CountCellsInRanges As Double, CountAreasInRanges As Double, CheckValue As Double, PercentChange As Double
Dim CodesToClean() As Variant
Dim RangeSheet As Worksheet
Dim TransNavKeys As Boolean

' Initialise character codes to be replaced
CodesToClean() = Array(127, 129, 141, 143, 144, 157, 160)

' Store the workshsheet object that the function is working in
Set RangeSheet = RangeIn.Parent
'Check that a range exists for this function to operate on, otherwise exit
If RangeIn.SpecialCells(xlConstants, xlTextValues).count = 0 Then Exit Sub
'Skip worksheets that contain the following
If RangeSheet.PivotTables.count <> 0 Then Exit Sub


' Set the range, deciding whether or not to include cells with validation (that may potentially be violated by cleaning and replacing etc).
If ExcludeValidationCells Then
' Check there are cells in the range.
If RangeIn.SpecialCells(xlCellTypeAllValidation) Is Nothing Then Exit Sub
' Otherwise, calculate the range that is in TextConstRng and not in ValidationRng
Set ValidationRng = RangeIn.SpecialCells(xlCellTypeAllValidation)
Set TextConstRng = RangeIn.SpecialCells(xlConstants, xlTextValues)
Set OperationsRng = Complement(TextConstRng, ValidationRng)
Else
' Just operate on everything irrespective of potential data validation issues.
Set OperationsRng = RangeIn.SpecialCells(xlConstants, xlTextValues)
End If

'weird results when cleaning is done after the replacement, rather than before.

'******************
'Cleaning Operation
'******************


' Initialise the required counter variables
CountAreasInRanges = OperationsRng.Areas.count
CurrentProgressValue = 0
CheckValue = 0

If CleaningMode And CleanIt Then
For Each Area In OperationsRng.Areas

' Only update on a full percent change
PercentChange = 100 * CurrentProgressValue \ CountAreasInRanges
If CheckValue <> PercentChange Then
CheckValue = PercentChange
Application.StatusBar = "Currently on worksheet: '" & RangeSheet.Name & "' - Cleaning in progress: '" _
& CurrentProgressValue & " of " & CountAreasInRanges & ": " & _
Format(CheckValue, "#0\%") & "' - Macro Is Still Running!"
DoEvents
End If

With Area
.Name = "DaWorkinArea"
' Perform the CleaningMode operations.
.Value = [index(CLEAN(DaWorkinArea),)]
End With

' Iterate the progress counter
CurrentProgressValue = CurrentProgressValue + 1

Next Area
End If

'**********************
'Replacement Operation
'**********************

For i = LBound(CodesToClean) To UBound(CodesToClean)
' Display progress information in status bar
Application.StatusBar = "Currently on worksheet: """ & RangeSheet.Name & """ - Extra cleaning in progress: """ & i & " of " & UBound(CodesToClean) & ": " & Format(i / UBound(CodesToClean), "Percent") & """ - Macro Is Still Running!"
' Convert all extra codes to the ReplacementCode character for trimming by other functions or other means in Excel
OperationsRng.Replace What:=Chr(CodesToClean(i)), Replacement:=Chr(ReplacementCode), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Next i


' Display progress information in status bar
Application.StatusBar = "Currently on worksheet: """ & RangeSheet.Name & """ - All cleaning has been completed - The macro is still running."


'**********************
'All Other Operations
'**********************


' Initialise the required counter variables
CurrentProgressValue = 0
CheckValue = 0


' Set all cell formats to confirm they will stay as text throughout
' .SpecialCells(xlConstants, xlTextValues) seems to be selecting cells that are formatted as 'Date'
If CleaningMode And FormatIt Then OperationsRng.NumberFormat = "@"


For Each Area In OperationsRng.Areas

' Only update on a full percent change
PercentChange = 100 * CurrentProgressValue \ CountAreasInRanges
If CheckValue <> PercentChange Then
CheckValue = PercentChange
Application.StatusBar = "Currently on worksheet: '" & RangeSheet.Name & "' - Trimming & other operations in progress: '" _
& CurrentProgressValue & " of " & CountAreasInRanges & ": " & _
Format(CheckValue, "#0\%") & "' - Macro Is Still Running!"
DoEvents
End If

With Area
.Name = "DaWorkinArea"
' Perform the CleaningMode operations.
If CleaningMode And SizeIt Then .Value = [index(LEFT(DaWorkinArea, Length),)]
If CleaningMode And PrefixCharIt Then .Value = [index(DaWorkinArea,)] 'This sets the prefix character to blank, this can sometimes convert numbers stored as text, back to numbers
If CleaningMode And TextToNumIt Then .Value = [index(DaWorkinArea * 1,)] 'Multiplies cell value by one to make excel treat numbers stored as text, as numbers again
If CleaningMode And TrimIt Then .Value = [index(TRIM(DaWorkinArea),)]
If CleaningMode And ProperIt Then .Value = [index(PROPER(DaWorkinArea),)]
End With


' Iterate the progress counter
CurrentProgressValue = CurrentProgressValue + 1

Next Area


End Sub




'-----------------------------------------------------------------
'Temp Callers - Screen Updating etc, still enabled for troubleshooting.
'-----------------------------------------------------------------




Public Sub Call_TrimAll_Simple()
Call TrimAll(Selection, CleanIt + TrimIt)
End Sub




Public Sub Call_TrimAll_SimpleWorkbook()
'uses bitwise (base 2) enumerated CleanType data type, so options can be added together


Dim Cell As Range, OriginalCell As Range, WSCell As Range
Dim CodesToClean() As Integer, i As Integer, CurrentProgressValue As Integer
Dim WS As Worksheet, OriginalWS As Worksheet
Dim bStatusBar As Boolean


' ' Store the original position prior to running
' Set OriginalCell = ActiveCell
' Set OriginalWS = ActiveSheet


For Each WS In Worksheets
Call TrimAll(WS.UsedRange, CleanIt + TrimIt)
' Allow system to do events, then get VBA to wait for some number of seconds to aid stability
DoEvents
Application.Wait (Now() + CDate("00:00:01"))
Next WS


' OriginalWS.Activate
' OriginalCell.Select


End Sub

snb
08-29-2013, 06:43 AM
If a result is correct I usually do not switch any order to obtain a worse result.

You didn't post an example where, applying my suggested code, any problem occurs.
Now you are referring again to 'problem's'. Please post a sample workbook containing those 'problems'.
As I demonstrated the numberformatting can also be interfering with the code. We are unable to assess that as long as you don't post a representative workbook.

NB. You can't use a variable in a bracketed evaluate line

I do not see any need to work with areas

Simple_One
08-29-2013, 08:05 AM
It's not about switching it to obtain a worse result. It's about understanding why the two replacement operations produce a different outcome, when there is nothing different other than their order of implementation.
Look closely at cell A3 after the replace opertions in Sub M_snb() and compare it to M_snb_inverse(). The different outcome occurs after the first two lines of code and is unrelated to these lines of code:

.Name = "snb_001" .Value = [index(trim(snb_001),)]
.Value = [if(snb_001="","",If(column(snb_001)=4,If(isnumber(snb_001),text(snb_001,"'0000000000"),snb_001),snb_001))]

I'm trying to understand why that's the case...

When I apply your suggested code (I think it's your suggested code, as seen in the snbLong module) to my example workbook (it's attached again, with all the modules), that code does nothing to the worksheet cells that I see. The IF statements cause it skip past any of the 'working code'. I took this as a lesson in error handling, but perhaps it's functioning differently for you and does something to the worksheet cells that I'm not seeing?

There are also two modules of the code I'm playing with, one cleans by area, the other cleans by cell. Both are being called by the same sub from the Calling_subs module.
In terms of coding structure the two cleaning implementations are equivalent, as far as I can see, and I have been calling each of them using the arguments you see in:

Public Sub Call_TrimAll_SimpleWorkbook()

I'm aware of the error when no .specialcells are found ('no cells found'). Once I wrap my head around the replacing and cleaning, then I'll deal with that problem.
I'm aware I can avoid errors in the cleaning by changing the cell format using FormatIt option prior to running clean or trim operations; thats why I put that in a while back. However this might be an undesirable solution for others, hence I'm trying to understand fundamentally what is happening when I don't resort to doing that. One implementation (areas and index) succeeds and the other (cell and .value) fails. The areas implementation, will run without error even though cells D3 and D4 will turn to hashes and seem to suffer the same fate as in the cells implementation, i.e. they become numbers as far as excel is concerned, but; no overflow error occurs.
The cells implementation will encounter an overflow error as the cell is identified as a number after cleaning, when it gets passed to trim >>> overflow error. Changing the format prior to cleaning prevents this, but as mentioned, that might be undesirable for some, so I'm playing around to see if this can be done in other ways.

So, fundamentally, why does one succeed where the other fails, is it due to error trapping in the index function?
This is more about my understanding, I'm trying to get it through my head as to what is fundamentally different about the situations in terms of error handling or something that enables one to work...
If I just whack in an 'on error resume next' in the cells version, might it work in a similar way to the areas version and just skip past the overflow error?
If so, why does that happen in the area version when there is no 'on error resume next' (or something similar) in that code either?

Also, as far as I understand, I'm not using a variable in a bracketed evaluation line. If you are looking at 'DaWorkinArea', it's a named range, which is analogous to your implementation. I'm not sure where you are talking about if you are not referring to that?

Sorry if this stuff seems fundamental to you guys, I probably look like an idiot barking up the wrong tree, but I just don't get why one works and the other doesn't and I hate just accepting it without realising why it's the case...

snb
08-29-2013, 08:33 AM
Sub M_snb2()
On Error Resume Next

For Each Sh In Sheets
If Sh.PivotTables.count = 0 Then
Err.Clear
n = Sh.Cells.SpecialCells(2).count

If Err.Number = 0 Then
Sh.Columns(4).NumberFormat = "@"
With Sh.UsedRange
For Each it In Array(10, 160, 127, 129, 141, 143, 144, 157)
.Replace Chr(it), "", xlPart
Next
.Name = "snb_001"
.Value = [index(trim(snb_001),)]
End With
End If
End If

Next
End Sub

Simple_One
08-29-2013, 04:34 PM
Thanks for that, I see how the error handling works. The actual code is very similar to how my .Areas version works (no surprise because I stole the idea when I saw it in your original code).
The only real functional difference is I call CLEAN instead of directly replacing Char10. I also realised that it would be really easy to use TEXT(Clean(stuff),#) to avoid the overflow error as it would force each individual cell back to text, even if clean makes it otherwise. Not sure that the actual outcome is any different however from just setting all the cell formats to text though...

I'm guessing the answer to this next question is no; but is the code for any of the VB functions available to see anywhere? (I'm assuming not because it's a proprietary language, is it not?)
I think whats been killing my brain is that I assume functions like CLEAN work in a certain way based on their description, but maybe they have oddities that mean they don't always work how I think they do....

snb
08-30-2013, 01:46 AM
Did you F2 in the VBEditor ? (object Browser)

Simple_One
08-30-2013, 06:05 AM
Okay, I just worked out where you were talking about with the variable in a bracketed evaluate line, thanks.

Haven't played with the object browser, I'll have a look in there.

SamT
08-31-2013, 04:36 PM
F7 in Object browser to return to VBE