[Solved] Macro Looking for Blank cell or Cell with space(s) & deleting it

[Fr0mi]

hello everyone,

I am stuck on a problem, I want a macro that will look for a cell that has a space or more within and then deletes that cell automatically.
However the Excel sheet is relatively big and thus I do not want to go through the sheet cell by cell.. (My computer / Excel does not seem to manage it..)

I have also tried this, but that did not seem to work at all.. all cells with spaces were still there.

Sub clear()
    Dim c As Range
    For Each c In Range("A1:Z2000")
        If c = " " Then Range("A" & c.Row & ":A" & c.Row).ClearContents
    Next c
    For Each c In Range("A1:Z2000")
        If c = "  " Then Range("A" & c.Row & ":A" & c.Row).ClearContents
    Next c
    For Each c In Range("A1:Z2000")
        If c = "   " Then Range("A" & c.Row & ":A" & c.Row).ClearContents
    Next c
End Sub

** This is not my code, it was copied from the internet (slightly modified)

Thanks for the help in advance!

[westconn1]

your code only clears column A regardless of which column the spaces are found in, is that what you want?

are you looking for any cell content that contains any spaces or cells that contain only spaces?


one way to test for spaces is to use instr
or
if trim(c) = "" then c.clearcontents

for cells with spaces within other text
If Not c = Trim(c) Then c.ClearContents

[Fr0mi]

Thanks for the reply!

I already revised the code & had a look at yours.

Well basically both codes do not what I am aiming for. As now the clearcontents command seems to be applied to the whole row / range.

However, I wanted to look through the specified range and if one cell is found to have spaces but no text (should be empty) than I want to apply the clearcontents command to that single cell.

Yet, I do not want to go through the work sheet selecting every single cell, as that seems to crash my Excel & takes far too long.

Thanks for further help!

[Siddharth Rout]

However the Excel sheet is relatively big and thus I do not want to go through the sheet cell by cell..

Search the forum for .Find

[Fr0mi]

Thanks for the reply, I found your previous posts regarding the find command. However this does not work in my case.

I even downloaded your example code and changed the look for "Replace me" to " ". Then wrote a simple space into a cell and clicked on the macro. Response was "Not Found".

Besides I wanted to also delete the cells having maybe two or maybe three spaces in them. (I can always loop it once I have something that works, yes but maybe there is a better method)

Best,

[Siddharth Rout]

Ok let me give you an example...

EDIT
Do you want to delete the cell or do you want to clear the contents of the cell?

This works for me... for clearcontents

Sub FindAndDelete()
    Dim ws As Worksheet
    Dim aCell As Range
    Dim rRange As Range
    Dim srchString As String
    Dim Exitloop As Boolean
    
    '~~> Set the relevant worksheet
    Set ws = Worksheets("Sheet1")
    
    '~~> Working with the 1st Column. Change as applicable...
    Set rRange = ws.Columns(1)
    
    '~~> Search Space
    srchString = " "
    
    Set aCell = rRange.Find(What:=srchString, LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
        
    Do While Exitloop = False
        If Not aCell Is Nothing Then
            aCell.ClearContents
            Set aCell = rRange.FindNext(After:=aCell)
        Else
            '~~> If not found
            Exitloop = True
        End If
    Loop
End Sub

[anhn]

Need more treatment otherwise some cells that contain text such as "abc xyz" will be cleared.

I am lazy on typing, try this:

Sub FindSpaceCellsAndClear()
    Dim aCell As Range
    
    For Each aCell In Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeConstants)
        If Not aCell.Value Like "*[! ]*" Then aCell.ClearContents
    Next
End Sub

For easier to understand, the line
If Not aCell.Value Like "*[! ]*" Then
can be written as
If Trim(aCell.Value) = "" Then
or
If Len(Trim(aCell.Value)) = 0 Then
but the last two work 3 times slower.

[Fr0mi]

Thanks that works perfectly! Just what I was looking for.

However did you know if you have a combined cell in that worksheet the code outputs a '1004' run-time error? (Works fine just have to remove the combined cell - but still happens)

Thanks again anhn

[SQLADOman]

by "combined cell" do you mean a merged cell?

[Fr0mi]

Yes my bad, I meant merged cells.

[SQLADOman]

Some ideas to experiment with:

Dim aCell As Range
    
For Each aCell In Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeConstants)
    
    If aCell.MergeCells Then ' If cell is merged Then
        aCell.MergeCells = False ' unmerge cell
        aCell.Interior.ColorIndex = 6'to identify cell had been merged,change its color to Yellow
    End If
    
    'Choose which of the next two commands gives you the results you want
    'If Not aCell.Value Like "*[! ]*" Then aCell.ClearContents
    If Len(Trim(aCell.Value)) <> Len(aCell.Value) Then aCell.ClearContents

Next

[Fr0mi]

Thanks for the help!

For me that was not too much of a problem as I just had one cell merged with the next. However I wanted to mention it in case someone else would have a similar problem.

I am not sure how to do it myself, but can you use the .find function or something similar to look for formatted cells? Such as the yellow once to merge them again after the spaces have been removed?


Thanks though.

[SQLADOman]

It doesn't seem worth doing just for the purpose of providing the solution in case someone else might eventually need it.

The coloring only with one color, will not properly identify what was merged under some circumstances. Such as if there might be merged cells that includes more than one row and possibly two consecutive cells in the column are merged but not to each other.

As long as the merged cells are always in the same row and the primary cell is always in column A , I think it would be fairly easy. - But you need to do the coloring differently than how I did it in my previous post.

Something like this:

    Dim aCell As Range
    
    For Each aCell In Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeConstants)
    
    If aCell.MergeCells Then ' If cell is merged Then
         aCell.MergeArea.Interior.ColorIndex = 6 'to identify merged area
    aCell.MergeCells = False ' unmerge cell
   
    End If
    
    'Choose which of the next two commands gives you the results you want
    'If Not aCell.Value Like "*[! ]*" Then aCell.ClearContents
    If Len(Trim(aCell.Value)) <> Len(aCell.Value) Then aCell.ClearContents
    
    Next

[Fr0mi]

True it does not seem worth doing.

I appreciate your help anyhow!

Anyway I suppose you could do something like this:

Dim aCell As Range
    
    For Each aCell In Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeConstants)
    
    If aCell.MergeCells Then ' If cell is merged Then
         aCell.MergeCells = False ' unmerge cell

       ' Well do whatever action required
       'If Not aCell.Value Like "*[! ]*" Then aCell.ClearContents
       If Len(Trim(aCell.Value)) <> Len(aCell.Value) Then aCell.ClearContents
       
       Next

       ' Merge again and continue the search - Maybe that would stop the script from crashing

        aCell.MergeCells = True ' to merge them again should still be same selection or not?
    End If

[SQLADOman]

It would not be quite that easy, as aCell.MergeCells = True does not identify what range should be merged. You would need to give an instruction for that. Either store the merged range in a variable before un-merging, or use the colored range. Doing it right away like you thought of is a good idea though, because if you do use the colored range for the re-merge and then remove the coloring afterwards, that avoids the adjacent cell coloring issues that I mentioned before.

[SQLADOman]

I was bored so....., even though you were not in need, but only curious, here is one way of un-meging and re-merging.
Edit: Added different version below this version.

Private Sub CommandButton1_Click()
Dim aCell As Range
Dim MergedAdress As String
For Each aCell In Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeConstants)
    If aCell.MergeCells Then 'If aCell is merged Then
        MergedAdress = aCell.MergeArea.Address 'Load MergedAdress variable
        aCell.MergeCells = False 'unmerge range
        'If Not aCell.Value Like "*[! ]*" Then
        '--OR--
        If Len(Trim(aCell.Value)) <> Len(aCell.Value) Then aCell.ClearContents
        Range(MergedAdress).MergeCells = True 'merge stored address
        GoTo NextLoop
    End If
    If Len(Trim(aCell.Value)) <> Len(aCell.Value) Then aCell.ClearContents
NextLoop:
Next
End Sub

Version below process's the used range only in Column A
Edit:Changed the section of code that colors each instance of a merged range, to use alternating colors, because incrementing will fail if there are too many.

Sub Clear_Cell_Contents_If_Space_Before_or_After()
Dim aCell As Range, MergedAdress As String, BolMerged As Boolean
Dim wks As Worksheet, rng As Range, LastRow As Long, intColor As Integer
Set wks = ActiveSheet
With wks
    LastRow = .[A65536].End(xlUp).Row
    Set rng = .Range("A1:A" & LastRow)
End With
For Each aCell In rng 'rng = Cell A1 to LastRow In Column A
    BolMerged = False
    If aCell.MergeCells Then 'If aCell is merged Then
        BolMerged = True'If aCell is merged Set Boolean Flag for later use in routine
        MergedAdress = aCell.MergeArea.Address 'Load MergedAdress variable
        aCell.MergeCells = False 'unmerge range
    End If
   'Depending on the desired result use one of the next two commands
   'If Not aCell.Value Like "*[! ]*" Then aCell.ClearContents
   'See end of Post#7 for description of what the command above does.
   'Command below clears aCell if there is a space before or after it's contents.
    If Len(Trim(aCell.Value)) <> Len(aCell.Value) Then aCell.ClearContents
    If BolMerged = True Then 'If BolMerged Flag was set to True near the start of the Loop
          Range(MergedAdress).MergeCells = True 'merge stored address
          If intColor = 7 Then
                intColor = 6
             Else 'will alternate between two colors, if merged range is within a single row.
                intColor = 7'alternating inconstant if there are both single & multi-row merges.
          End If
          Range(MergedAdress).Interior.ColorIndex = intColor 'Color Variable
    End If
Next
End Sub

[anhn]

To deal with merged cells, you need just a simple fix as below. Do not unmerge then remerge the cells.

Sub FindSpaceCellsAndClear()
    Dim aCell As Range
    
    For Each aCell In Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeConstants)
        If Not aCell.Value Like "*[! ]*" Then aCell.MergeArea.ClearContents
    Next
End Sub

[Fr0mi]

Thanks guys!
I havnt been online for a while so here is the thanks!