Solved: VBA code for removing blank cells in a list

[paulxl]

I have a spreadsheet that will return both values and " " values in a column. I need to extract the values from this column and place them in a report. The data in the column will change on a regular basis and hence the number of lines in the report will also vary. I have been trying to adapt Chip Pearson's code listed below without success. This would be fine if the non value cells were blank but the fact that they contain a " " renders the macro unusable. Any ideas to adapt this would be greatly appreciated.
[vba]Function NoBlanks(RR As Range) As Variant
Dim Arr() As Variant
Dim R As Range
Dim N As Long
Dim L As Long
If RR.Rows.Count > 1 And RR.Columns.Count > 1 Then
NoBlanks = CVErr(xlErrRef)
Exit Function
End If

If Application.Caller.Cells.Count > RR.Cells.Count Then
N = Application.Caller.Cells.Count
Else
N = RR.Cells.Count
End If

ReDim Arr(1 To N)
N = 0
For Each R In RR.Cells
If Len(Trim(R.Value)) > 0 Then
N = N + 1
Arr(N) = R.Value
End If
Next R
For L = N + 1 To UBound(Arr)
Arr(L) = vbNullString
Next L
ReDim Preserve Arr(1 To L)
If Application.Caller.Rows.Count > 1 Then
NoBlanks = Application.Transpose(Arr)
Else
NoBlanks = Arr
End If
End Function
[/vba]

[jolivanes]

paulxl
Single line code like that is hard to comprehend but could you insert a TRIM function somewhere?

Or something like

If c.Value = " " Then EntireRow.Delete

[paulxl]

Sorry about the code. Have corrected it now. I did try replacing the line [VBA]If Len(R.Value) > 0 Then[/VBA]

with [VBA]If Len(Trim(R.Value)) > 0 Then[/VBA]

but this just repeated the first value in the list. Not certain where I should insert your code

[Kenneth Hobs]

Replacing that line of code worked for me.

[VBA]' Chip Pearson, http://www.cpearson.com/excel/NoBlanks.aspx
Function NoBlanks(RR As Range) As Variant
Dim Arr() As Variant
Dim R As Range
Dim N As Long
Dim L As Long
If RR.Rows.Count > 1 And RR.Columns.Count > 1 Then
NoBlanks = CVErr(xlErrRef)
Exit Function
End If

If Application.Caller.Cells.Count > RR.Cells.Count Then
N = Application.Caller.Cells.Count
Else
N = RR.Cells.Count
End If

ReDim Arr(1 To N)
N = 0
For Each R In RR.Cells
' Trim added cells with just space characters to be considered empty.
' http://www.vbaexpress.com/forum/showthread.php?t=40685
If Len(Trim(R.Value)) > 0 Then
N = N + 1
Arr(N) = R.Value
End If
Next R
For L = N + 1 To UBound(Arr)
Arr(L) = vbNullString
Next L
ReDim Preserve Arr(1 To L)
If Application.Caller.Rows.Count > 1 Then
NoBlanks = Application.Transpose(Arr)
Else
NoBlanks = Arr
End If
End Function
[/VBA]

[jolivanes]

I am not much of a coder Paul but you could try

Set Rng = Range(Rows(1), _
                Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row()))
RwCnt = 0
    For Rw = Rng.Rows.Count To 1 Step -1
        If Application.WorksheetFunction.CountA(Rng.Rows(Rw).EntireRow) = 0 Then
            Rng.Rows(Rw).EntireRow.Delete
            RwCnt = RwCnt + 1
        End If
    Next Rw

If you put this just below the "Dim L As Long" statement, it might work.
I am sure that someone else will come up with a much better solution (I hope so anyway).
In the meantime you could try it on a copy of your workbook.

[paulxl]

Not working for me. I just get the first value repeated. Tried using the formula NoBlanks with cell references and range reference, as an array formula and without the array brackets but all with the same result

[Kenneth Hobs]

I can't see over your shoulder so either use Chip's file or post your problem file. In Chip's file add the space character to a "blank" cell and test. Of course you need to replace that one line of code in his routine.

[jolivanes]

You have Kenneth Hobs on your side so I'll just follow the thread so I can learn from Kenneth also.

[paulxl]

OK. Here is a sample of what I'm trying to do. Can't use the real data as it is sensitive.

The blue box is a range called Number and the red box contains the formula

[paulxl]

Thanks for trying jolivanes, eh!

[Kenneth Hobs]

I did not see a red box in our example. In this one based on your last file, I showed both routines. I just changed the one that we modified to be NoBlanks2(). I only set one cell with a space character so that you could compare the two routines.

[jolivanes]

I found this in my storage drawer.
It works on your example eh!!

Sub DelBlankRws()
Application.ScreenUpdating = False
    start = Timer
    Cells.AutoFilter
    With ActiveSheet.Range("$C$3", Range("C" & Rows.Count).End(xlUp))
        .AutoFilter Field:=1, Criteria1:=" "
        .EntireRow.Delete
    End With
    Cells.AutoFilter
    Application.ScreenUpdating = True
    MsgBox "Macro took " & (Timer - start) & " seconds to run."
End Sub

Good luck
John

[paulxl]

Sorry to be such a pain but I now realise that I should have told you that the data was a formula result and not randomly entered data. This still leaves me with my original problem as you can see from the new boxes I've included on you example. I don't know what colour the supposed red box on my first attachment really was, and being somewhat colour blind I'm not even going to hazard a guess on the colours of the new boxes

[paulxl]

Good try jolivanes but there is info in the columns either side of the " "'s

[Kenneth Hobs]

I call that light green for the border. If you hover over a color in the color picker dialog, for some colors, you get a description for what that is worth.

I still can not duplicate your problem. When I select N3:N12, press F2, press Ctrl+Shift+Enter, 1-7 is filled as expected.

Maybe you should explain how you do your thing. Keep in mind that I am slow...

[paulxl]

OK. Please kick me! I've been entering the array formula wrong! I've been arraying the first cell and then copying it down. Don't know when I got into that bad habit, haven't worked with array formulas for a while.

Sorry to have taken up so much of your time but I do appreciate your quick responses and I can at least go to bed with something accomplished tonight.

Yours shamefacedly

Paul

[jolivanes]

Just for the heck of it.
If you do have problems with colors, this will give you the right border color of the selected cell

Sub ShowColour()
Dim RGBColour As String, R As Integer, G As Integer, B As Integer
RGBColour = Right("000000" & Hex(ActiveCell.Borders(xlEdgeRight).Color), 6)
R = WorksheetFunction.Hex2Dec(Right(RGBColour, 2))
G = WorksheetFunction.Hex2Dec(Mid(RGBColour, 3, 2))
B = WorksheetFunction.Hex2Dec(Left(RGBColour, 2))
MsgBox "RGB" & vbTab & R & ", " & G & ", " & B & vbCrLf & "Index" & vbTab & ActiveCell.Borders(xlEdgeRight).ColorIndex
End Sub

[paulxl]

jolivanes. I have no problem at all with colours but it does occur to me that everyone else doesn't see what I see!

Seriously, though, I often put a border round a cell and then need to use the same colour later for another cell for continuity. I usually find I can't remember what colour I used and end up having to recolour both borders just to make sure I have the same colour, so your code is going to come in useful. Thanks