Show effected cells when removing unnecessary space characters

Berenloper

Board Regular
Joined
May 28, 2009
Messages
83
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Hi,

What you are calling unnecessary spaces ... Code 32 ...?
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
Solution
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
 
Upvote 0
Glad we could help & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,212,934
Messages
6,110,762
Members
448,295
Latest member
Uzair Tahir Khan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top