I have this Column A and I have these 2 images in Rows 1 and 4: here is the before
I want a loop to go through column A and if the cell is empty then copy the cell above with the image in it (the image is locked inside the cell and moves/resizes/filtered with it, like this
Thank you all in advance.
Tried this for non-images and it works (easier)
Sub IfEmpty_CopyAboveCell()
Dim i As Integer
Dim LastRow As Integer
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = ActiveCell.Row To LastRow
Cells(i, ActiveCell.Column).Select
If Cells(i, ActiveCell.Column) = "" Then
Cells(i, ActiveCell.Column) = Cells(i - 1, ActiveCell.Column)
End If
Next i
End Sub
With images invloved it becomes trickier (didn't work yet):
Sub IfEmptyImages_CopyAboveCell()
Dim i As Integer
Dim LastRow As Integer
Application.CopyObjectsWithCells = True
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = ActiveCell.Row To LastRow
Cells(i, ActiveCell.Column).Select
If CellImageCheck(Cells(i, ActiveCell.Column)) = 0 Then
Cells(i - 1, ActiveCell.Column).Copy
Selection.offset(1, 0).Paste
Cells(i, ActiveCell.Column).Paste
'Cells(i, ActiveCell.Column) = Cells(i - 1, ActiveCell.Column)
End If
Next i
End Sub
Function CellImageCheck(CellToCheck As Range) As Integer
' Return 1 if image exists in cell, 0 if not
Dim wShape As shape
For Each wShape In ActiveSheet.Shapes
If wShape.TopLeftCell = CellToCheck Then
CellImageCheck = 1
Else
CellImageCheck = 0
End If
Next wShape
End Function