Trimming all cells to 28 characters

[Imrhien]

Hey folks!

I've been working on a macro to prepare a spreadsheet for upload to our database. There are a few stringent rules - the first of which is that the cells cannot contain more than 28 characters. Here's the code I have at the moment:

' 12. Trim all cells (at the moment, every worksheet) to 28 characters
Dim c As Range
Dim i As Long
For i = 1 To Worksheets.Count
For Each c In Worksheets(i).UsedRange.Cells
If Len(c) > 28 Then
c.Value = Left(c, 28)
End If
Next
Next i

This works, except for when I use spreadsheets with large numbers of rows, at which point I get an Overflow error, which highlights "If Len(c) > 28 Then".

I'm guessing that variable "c" is getting over-filled. Not sure how I can cope with this however, as I can't seem to get any other variable types to work.

The code does not need to run on every worksheet; only Sheet1.

Looking forward to your replies

 

[Imrhien]

nudge

 

[Trevor G]

Have you tried using left and set to 28

=left(A1,28) as an example.

Recorded Macro sample below

Sub Macro1()
'
' Macro1 Macro
'
'
Range("B2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[1],28)"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B21")
Range("B2:B21").Select
End Sub

 

[Imrhien]

I gave your code a shot but it doesn't seem to do the trick.

However, I might be able to avoid Overflows if I attack each column individually...

Thanks for the inspiration! I'll test my idea.

 

[Jonmo1]

If you're going to do each collumn individually, try using Text to columns - Fixed Width.

Use the macro recorder to get the syntax.
That will be quicker than looping each cell in the column.

 

[Jonmo1]

Try this using Text To Columns

Sub Macro1()
Dim ws As Worksheet, c As Range
For Each ws In Worksheets
    For Each c In Intersect(ws.UsedRange, ws.Cells(1, 1).EntireRow)
        On Error Resume Next
        ws.Columns(c.Column).TextToColumns Destination:=c, DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(28, 9))
        On Error GoTo 0
    Next c
Next ws
End Sub

 

[Imrhien]

That works perfectly for text!!! When it trims numbers, however, you get the typical "1.11111111111111E+61" kind of thing. Is there any way this can be avoided?

Awesome script so far though. Far cleaner and more efficient than my current one.

 

[Jonmo1]

Try

Sub Macro1()
Dim ws As Worksheet, c As Range
For Each ws In Worksheets
    For Each c In Intersect(ws.UsedRange, ws.Cells(1, 1).EntireRow)
        On Error Resume Next
        ws.Columns(c.Column).TextToColumns Destination:=c, DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 2), Array(28, 9))
        On Error GoTo 0
    Next c
Next ws
End Sub

 

[Imrhien]

Same result for cells containing numbers without spaces.

Example data:

111111111111111111111111111111111111111111111111111111111111111

does not get fixed correctly,


11111111111 11111111111111111 111111111111111111111111 111111111

does get fixed correctly.

 

[Jonmo1]

Something is not right here....

To my knowledge, a cell can't hold a NUMBER that is more than 15 significant digits.
So if you have a cell that is 60 some odd characters long, then it cannot be stored as a number, must be what is called "Number Stored As Text".
Therefore the code I provided treats it as TEXT.
So should not be converted to a scientific number.


Look at one of those cells that contain numbers (prior to running the macro)
What do these formulas return

=ISNUMBER(A1)
=LEN(A1)

Where A1 is a cell holding one of these numbers.