Select & Copy Only Non Blank Cells in Excel VBA, Don't Overwrite

Question

I cant seem to find a solution for my application after endless searching. This is what I want to do:

I have cells in one excel sheet that can contain a mixture of dates and empty cells in one column. I want to then select the cells that have only dates and then copy them to a corresponding column in another sheet. They must be pasted in exactly the same order as in the first sheet because there are titles attached to each row. I do get it right with this code:

'Dim i As Long

'For i = 5 To 25

'If Not IsEmpty(Sheets("RMDA").Range("D" & i)) Then _

Sheets("Overview").Range("D" & i) = Sheets("RMDA").Range("D" & i)

'Next i

However, the dates in the first sheet are being updated on a daily basis and it can be that one title has not been updated (on another day) on the first sheet because the user has not checked it yet. If I leave it blank and If I follow the same procedure then it will "overwrite" the date in the second sheet and make the cell blank, which I do not want. I hope I was clear. Can someone please help me?

Regards

Answer 1

You can accomplish this very easily (and with little code) utilizing Excel's built-in AutoFilter and SpecialCells methods.

With Sheets("RMDA").Range("D4:D25")

    .AutoFilter 1, "<>"

    Dim cel as Range
    For Each cel In .SpecialCells(xlCellTypeVisible)

        Sheets("Overview").Range("D" & cel.Row).Value = cel.Value

    Next

    .AutoFilter

End With

Answer 2

you could try something like. This will give you the non blanks from the range, there may be an easier way... hope it helps

Sub x()

Dim rStart As Excel.Range
Dim rBlanks As Excel.Range

Set rStart = ActiveSheet.Range("d1:d30")
Set rBlanks = rStart.SpecialCells(xlCellTypeBlanks)

Dim rFind As Excel.Range
Dim i As Integer
Dim rNonBlanks As Excel.Range

For i = 1 To rStart.Cells.Count
    Set rFind = Intersect(rStart.Cells(i), rBlanks)
    If Not rFind Is Nothing Then
        If rNonBlanks Is Nothing Then
            Set rNonBlanks = rFind
        Else
            Set rNonBlanks = Union(rNonBlanks, rFind)
        End If
    End If
Next i

End Sub

Answer 3

Just because a cell is blank does not mean that it is actually empty.

Based on your description of the problem I would guess that the cells are not actually empty and that is why blank cells are being copied into the second sheet.

Rather than using the "IsEmpty" function I would count the length of the cell and only copy those which have a length greater than zero

Dim i As Long

For i = 5 To 25

If Len(Trim((Sheets("RMDA").Range("A" & i)))) > 0 Then _

Sheets("Overview").Range("D" & i) = Sheets("RMDA").Range("D" & i)

Next i

Trim removes all spaces from the cell and then Len counts the length of the string in the cell. If this value is greater than zero it is not a blank cell and therefore should be copied.