VBA to Search Column for Blanks then Copy/Paste Based on the Blank Cell Location

[clerario]

I am attempting to search through a dynamic column which may have x number of blank cells and y number of cells with dates. I want to search the column for the first blank cell, then copy the cell immediately above it and paste it on a new sheet, I also want to copy the cell immediately below the blank cell and paste that on a different column in that new sheet. I want to repeat this so that I have a column of all cells above the blank cells from the original sheet in the new sheet and a separate column for all cells below in the new sheet.

this is my code which does not work fully, and also takes and copy's a different cell in the last column, which I need to do as well.

"Dim lRealLastRow As Long
Dim lRealLastColumn As Long
Dim i As Integer
Dim intRowCount As Integer

intRowCount = Sheets("Damages").Range("P1")

For i = 1 To intRowCount

Range("A1").Select
On Error Resume Next
lRealLastRow = Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
lRealLastColumn = Cells.Find("*", Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
Cells(lRealLastRow, lRealLastColumn).Select
Selection.copy
Sheets("Temp Data").Select
Sheets("Temp Data").Range("D1").Select
Range(D1).Select
Range("D1").End(xlDown).Select

If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Select
End If


Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Review").Select
ActiveCell.Offset(1, -4).Select

Next i
End Sub"

 

[jbeaucaire]

Let's simplify.

1) in the active sheet, examine all the cells in one column (column D?) looking for blanks

2) For each blank found, put the cell above into a new sheet (Sheet "Report" ?) in column A and the cell below next to it in column B.

3) Repeat for all blank cells in the specified column


Please correct the sheet names and column references, I'm sure we can get something simple for you.

 

[clerario]

Yes, I want to search for a blank in the ActiveSheet ("Review" in my case) column A and then

For each blank found, put the cell above into a new sheet (Sheet "Temp Data" ) in column A and the cell below next to it in column B.

and yes Repeat for all blank cells in the specified column

 

[jbeaucaire]

Give this a whirl, this assumes these cells are truly blank, not just blank in appearance:

Option Explicit

Sub BlankReview()
Dim blankRNG As Range, blank As Range, NR As Long

On Error Resume Next
Set blankRNG = ActiveSheet.Range("A:A").SpecialCells(xlBlanks)

    If Not blankRNG Is Nothing Then
        With Sheets("Temp Data")
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1
        
            For Each blank In blankRNG
                .Range("A" & NR).Value = blank.Offset(-1).Value
                .Range("B" & NR).Value = blank.Offset(1).Value
                NR = NR + 1
            Next blank
        End With
    Else
        MsgBox "No blank cells found in column A"
    End If
End Sub

 

[clerario]

Thank You Sir! After some tweaking it works just like I want it to, I had to clear the columns in "Temp Data" before the macro is run each time and added:
Range("F" & NR).Value = blank.Offset(-1, 4).Value

because I needed one more cell on "Review" transferred to "Temp Data"