Show effected cells when removing unnecessary space characters

[Berenloper]

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:

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]

Hi,

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

 

[Fluff]

How about

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]

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]

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]

Not quite sure why it would do that, but try

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]

Here is another macro that you can consider...

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]

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

Thanks guys. I'm happy with it.

Regards,
Berenloper

 

[Fluff]

Glad we could help & thanks for the feedback