Move cells up based on cell above

[cfp14]

Hi All,

I need some major help haha. I'm a total newbie to VBA, started out of necessity. I need to write a function that when data from sheet 1 is inserted to sheet 2 it looks at that new data and if the cell above it is empty it moves the cell up until no empty cells remain. So essentially top justifying the cells, if that makes any sense. I don't want to just delete the empty rows as I have a set amount of 50 and need it to stay at 50. I'm not sure what the best way to go about this is but I'll give you what I have. For all I know (not a whole lot) this is all wrong. Any help is greatly appreciated!

Sub Move_Cell_Up()
    Dim rng As Range
    Dim cell As Range
    Set rng = ActiveSheet.Range("D7:D56,E7:E56")
    For Each cell In rng
        If ActiveCell.Offset(1, 0) = " " Then
            Selection.Offset(1, 0).Select
        Else
            Selection.Offset(0, 0).Select
        End If
    Next cell
End Sub

 

[Snakehips]

cfp14, Not wishing to be unkind but FYI your code is not doing what you might hope. See the notes below.

Sub Move_Cell_Up()    Dim rng As Range
    Dim cell As Range
    Set rng = ActiveSheet.Range("D7:D56,E7:E56")  [COLOR=#ff0000]'set range variable[/COLOR]
    For Each cell In rng [COLOR=#ff0000] 'loop through cells in [/COLOR][COLOR=#ff0000]range[/COLOR]
[COLOR=#ff0000]    'ActiveCell = whatever you have selected and is NOT [/COLOR][COLOR=#ff0000]cell[/COLOR]
        If ActiveCell.Offset(1, 0) = " " Then [COLOR=#ff0000] 'If ActiveCell = ''a space character'' ??[/COLOR]
            Selection.Offset(1, 0).Select. [COLOR=#ff0000]'unlikely to happen[/COLOR]
        Else
            Selection.Offset(0, 0).Select
[COLOR=#ff0000]            'So will likely do nothing at all[/COLOR]
        End If
    Next cell  [COLOR=#ff0000]' do nothing to all the other cells[/COLOR]
End Sub

So you are pasting data into D7:E56 ?
There are some blanks?
Blank rows as in D & E are both blank or D & E can be independently blank?
Both need to be top justified within the range?
Blank cell is blank as in "" not " " as with space character?

 

[cfp14]

Thanks for the reply, not unkind at all haha. I have very little-no clue as to what I'm doing when it comes to writing VBA as you can tell. Let me explain a little more. On sheet1 is a checklist of items. Based on which line items are checked (with a checkbox) I've already written a formula to take that information from the row corresponding to the checklist and insert it into a "to do list" on another sheet. But lets say I check rows 1,3,5. It then takes the info from those rows and directly copies them over to the other sheet with the spaces on rows 2 and 4 included. however I don't want those spaces I need the code to see the spaces between the inserted rows and justify the cells to the top so the info from 1,3,5 is in 3 rows instead of 5. Did I explain that clearly?

Example of sheet 2 with data input from sheet 1:

[TABLE="width: 480"]
<tbody>[TR]
[TD]Item[/TD]
[TD]Form Reference #[/TD]
[TD="colspan: 2"]Action Item[/TD]
[TD][/TD]
[/TR]
[TR]
[/TR]
[TR]
[TD]1.[/TD]
[TD]1.0[/TD]
[TD="colspan: 2"]Test1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2.[/TD]
[TD][/TD]
[TD="colspan: 2"][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3.[/TD]
[TD]3.0[/TD]
[TD="colspan: 2"]Test3[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4.[/TD]
[TD][/TD]
[TD="colspan: 2"][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5.[/TD]
[TD]5.0[/TD]
[TD="colspan: 2"]Test5[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

As you can see the spaces at 2 and 4 are what I need to get rid of with the code.

 

[Snakehips]

So your headers are row 6? then 50 items?
Blanks in D & E and never just D or just E?

 

[cfp14]

Correct, headers are row 6 and rows 7-56 is where the info goes. The way its set up its impossible for it to be just D or Just E. Its either all the information from that row or none of it.

 

[Snakehips]

There are ways you could do similar to you were trying with your code, by looping through row by row and shifting up.
But I suspect there is no reason why you could not be more direct and do as per the below.
Try it on a backed up copy.

Sub RidBlanks()Application.ScreenUpdating = False
    Range("D7:E56").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp
    Range("D7").Select
Application.ScreenUpdating = True
End Sub

Hope that helps.

 

[cfp14]

Awesome, thanks so much! Its saying no cells were found, Is that due to the formula in each cell? Even though there's no text in the cells each one has a formula

 

[cfp14]

Disregard that, Its the formulas. Ill just put them elsewhere. Thanks again!

 

[Snakehips]

You are welcome.
Formulas? Nobody mentioned formulas ......

 

[cfp14]

Another question. Is there any way to do this non-destructively to the cells below? Because when the code is run it deletes the cell instead of only switching the cells location. For it to Ignore the formula but recognize the lack of text in the cell would you have to write a validation? And one more thing, would it be possible to make it run the macro every time new data is input ?