Show effected cells when removing unnecessary space characters

Berenloper

Board Regular
Joined
May 28, 2009
Messages
73
Hi everyone,

I'm trying to change the cell format if a cell will be effected by a VBA trim-function.
This is the code I have:

VBA Code:
Sub DataCheck()

    Dim xRg As Range
    Dim xCell As Range
    Dim counter As Integer
    On Error Resume Next

    counter = 0

    MsgBox ("Starting Check...")
    Set xRg = Range("RangeCheck") 'A given Range

    Application.ScreenUpdating = False
    For Each xCell In xRg
    If Not IsEmpty(xCell.Value) Then
        xCell.Value = Application.Trim(xCell.Value) 'Remove unnecessary spaces
            If 0 < InStr(xCell, Chr(10)) Then 'xCell = Replace(xCell, Chr(10), "") 'Check for Line Feed character
                counter = counter + 1
                With xCell.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                End With
                With xCell.Font
                .Color = -16777024
                End With
            End If

            If 0 < InStr(xCell, Chr(34)) Then 'xCell = Replace(xCell, Chr(34), "") 'Check for Carriage Return character
                counter = counter + 1
                With xCell.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                End With
                With xCell.Font
                .Color = -16777024
                End With
            End If
    End If
    Next
    Application.ScreenUpdating = True
    MsgBox ("Check finished. There are " & counter & " errors found!")
    
End Sub
The code works fine when Line Feed and Carriage return characters are present.
So, I like to have the same when unnecessary spaces are present (but not yet have to be removed), just to see which cells will be effected.
Now they are removed by the code "xCell.Value = Application.Trim(xCell.Value)"

Does anyone has an idea?

Regards,
Berenloper
 

James006

Well-known Member
Joined
Apr 4, 2009
Messages
3,669
Hi,

What you are calling unnecessary spaces ... Code 32 ...?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,523
Office Version
365
Platform
Windows
How about
VBA Code:
Sub DataCheck()

    Dim xRg As Range
    Dim xCell As Range
    Dim counter As Long
    
    MsgBox ("Starting Check...")
    Set xRg = Range("RangeCheck") 'A given Range

    Application.ScreenUpdating = False
    For Each xCell In xRg
        If Not IsEmpty(xCell.Value) Then
            If xCell.Value <> Application.Trim(xCell.Value) Or InStr(xCell, Chr(10)) > 0 Or InStr(xCell, Chr(34)) > 0 Then
                counter = counter + 1
                With xCell.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 65535
                End With
                xCell.Font.Color = -16777024
            End If
        End If
    Next xCell
    Application.ScreenUpdating = True
    MsgBox ("Check finished. There are " & counter & " errors found!")
End Sub
 

Berenloper

Board Regular
Joined
May 28, 2009
Messages
73
Hi James006. Thanks for replying. The trim-function here removes e.q. double spaces in cells.

@Fluff:
Wow, you're code looks pretty nice! I wouldn't have thought of it.
I'll have to check it at a later moment, but I let you know the results.

Regards,
Berenloper
 

Berenloper

Board Regular
Joined
May 28, 2009
Messages
73
Hi Fluff,

You're code works perfect I think (thanks!), but also a weird thing happens.
A standard formated cell with only numbers is also getting effected, but a cell with only numbers formated as text is un-effected. Do you have an explanation for that?

Regards,
Berenloper
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,523
Office Version
365
Platform
Windows
Not quite sure why it would do that, but try
VBA Code:
Sub DataCheck()

    Dim xRg As Range
    Dim xCell As Range
    Dim counter As Long
    
    MsgBox ("Starting Check...")
    Set xRg = Range("RangeCheck") 'A given Range

    Application.ScreenUpdating = False
    For Each xCell In xRg
        If Not IsEmpty(xCell.Value) Then
            If Len(xCell.Value) <> Len(Application.Trim(xCell.Value)) Or InStr(xCell, Chr(10)) > 0 Or InStr(xCell, Chr(34)) > 0 Then
                counter = counter + 1
                With xCell.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 65535
                End With
                xCell.Font.Color = -16777024
            End If
        End If
    Next xCell
    Application.ScreenUpdating = True
    MsgBox ("Check finished. There are " & counter & " errors found!")
End Sub
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
35,426
Office Version
2010
Platform
Windows
Here is another macro that you can consider...
VBA Code:
Sub DataCheck()
  Dim X As Long, Cell As Range, CellVal As String
  Application.ScreenUpdating = False
  For Each Cell In Range("RangeCheck")
    CellVal = Cell.Value
    If CellVal Like " *" Or CellVal Like "* " Or CellVal Like "*  *" Or CellVal Like "*[""" & vbLf & "]*" Then
      X = X + 1
      Cell.Interior.Color = vbYellow
      Cell.Font.Color = vbRed
    End If
  Next
  Application.ScreenUpdating = True
  MsgBox ("Check finished. There are " & X & " errors found!")
End Sub
 

Berenloper

Board Regular
Joined
May 28, 2009
Messages
73
Hi Fluff and Rick,

Both your solutions work perfect. The formatting problem with a nummeric cell Fluff, is also gone. Good job!
Now I'm facing a next problem… Which one to use. I like them both :unsure:

Thanks guys. I'm happy with it.

Regards,
Berenloper
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,523
Office Version
365
Platform
Windows
Glad we could help & thanks for the feedback
 

Forum statistics

Threads
1,078,435
Messages
5,340,250
Members
399,361
Latest member
Linford

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top