Copying Data to Blank cells abovbe data in same Column

[SAMCRO2014]

I am trying to copy and paste data in column A to the blank cells above it.

For example: Cell A5 contains "1203" and I want it copied to the blank cells above A1:4
Cell A12 contains "1237" and I want it copied to the blank cells above A6:11
Cell A18 contains "1291" and I want it copied to the blank cells above A13:17

These cell reference are variable and will change depending on the data in the report. I know I need to do this with a loop (I think) but I am confusing myself trying to figure it out.

Any suggestions?

 

[BarryL]

Hi, does the below work for you?

Sub test()
    Dim lr As Long, i As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For i = lr To 1 Step -1
    If Range("A" & i).Value = "" Then Range("A" & i).Value = Range("A" & i + 1).Value
    Next
End Sub

 

[Fluff]

Another option

Sub CopyUp()
   With Range("A:A")
      .SpecialCells(xlBlanks).FormulaR1C1 = "=r[1]c"
      .Value = .Value
   End With
End Sub

 

[SAMCRO2014]

It didn't work but I think it may have to do this my coding before it. In column C there are random data in cells that look like "Totals for Cost Center 0120140100 - DIRECTOR". I am trying to loop through column C to find these cells and only take the "120140100" portion of the string and copy it over to the adjacent cell in column A. One the loop was completed I want to copy and paste as above. Here is my coding:


'Set variables
Dim LastRowSH As Long
LastRowSH = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row

Dim Data As Worksheet
Set Data = ThisWorkbook.Sheets("Data")

Dim x As Long

'Find cost centres in column C and use MID function to copy the cost centre to adjacent cell in Column A
For x = 2 To LastRowSH - 1

If Data.Cells(x, 3).Value Like "*Total*" Then
Data.Cells(x, 3) = Mid(Cells(x, 3), 25, 9).Offset(-2, 0)
End If
Next x

'Delete column C
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft

'Copy cost centres to above empty cells
With Range("A:A")
.SpecialCells(xlBlanks).FormulaR1C1 = "=r[1]c"
.Value = .Value
End With

 

[MARK858]

Maybe change

If Data.Cells(x, 3).Value Like "*Total*" Then
Data.Cells(x, 3) = Mid(Cells(x, 3), 25, 9).Offset(-2, 0)
End If
Next x

to

If Data.Cells(x, 3).Value Like "*Total*" Then
Data.Cells(x, 1) = Mid(Cells(x, 3), 25, 9)
End If
Next x

 

[SAMCRO2014]

That did not work either I was trying to avoid using text to columns but I may have to.

 

[Fluff]

In what way didn't it work?

 

[MARK858]

You need to give more description than just "did not work" in your posts.

Also change

If Data.Cells(x, 3).Value Like "*Total*" Then
Data.Cells(x, 1) = Mid(Cells(x, 3), 25, 9)
End If
Next x

to

If Data.Cells(x, 3).Value Like "*Total*" Then
Data.Cells(x, 1) = Mid([COLOR="#FF0000"]Data.[/COLOR]Cells(x, 3), 25, 9)
End If
Next x

 

[SAMCRO2014]

I have the MID function working now. Thanks

I think I need a loop to find the value in column a (A5 for example) and paste it to the above blank cells (A1:4) and then go find the next value say A15 and paste it to the above blank cells A6:14, and so on.

The coding provided above just give me "0" in Column A

 

[MARK858]

With Data.Range("A:A")
  .SpecialCells(xlBlanks).FormulaR1C1 = "=R[1]C"
  .Value = .Value
End With

works fine for me