Macro to Move

[WillPeters]

Hello all,

I need help with a macro to move rows/cells, similar to deleting a row and shifting everything up, but not, because there is important content outside of the table that should remain static. So, to clarify:

The area I'm speaking of is from D4 to F15 only. Within this area, if there is row that has an empty E cell, the contents in the rows below should shift upwards in unison, maintaining its alignment/pairing with each other until there is no empty E cells above the rows (yes, overwriting content in D and F as long as E is empty). And keep in mind that the contents outside of D4 to F15 should remain still with no movement. Thank you in advance for your input and guidance!

 

[mumps]

Try:

Sub DeleteCells()
    Application.ScreenUpdating = False
    Dim rng As Range
    For Each rng In Range("E4:E15")
        If rng = "" Then
            Range("D" & rng.Row).Resize(, 3).Delete shift:=xlUp
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[WillPeters]

Try:

Sub DeleteCells()
    Application.ScreenUpdating = False
    Dim rng As Range
    For Each rng In Range("E4:E15")
        If rng = "" Then
            Range("D" & rng.Row).Resize(, 3).Delete shift:=xlUp
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

Thank you! The macro worked as expected. But it shifted the contents below D14:F14 up as well. I need those below D14:F14 to stay put. Any way we can only limit the moving cells to D4:F15?

 

[mumps]

Misposted.

 

[mumps]

Try:

Sub DeleteCells()
    Application.ScreenUpdating = False
    Dim rng As Range
    For Each rng In Range("E4:E15")
        If rng = "" Then
            Range("D" & rng.Row + 1 & ":F15").Cut Range("D" & rng.Row)
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[WillPeters]

Try:

Sub DeleteCells()
    Application.ScreenUpdating = False
    Dim rng As Range
    For Each rng In Range("E4:E15")
        If rng = "" Then
            Range("D" & rng.Row + 1 & ":F15").Cut Range("D" & rng.Row)
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

Thank you! Appreciate you!

 

[mumps]

You are very welcome.

 

[WillPeters]

You are very welcome.

Uh oh, one last question, my cells are formatted to have white borders. After running the macro, the gray lines become visible. Any way we can have the shift upwards but retain the white border formatting? Almost like a clear content

 

[WillPeters]

Try:

Sub DeleteCells()
    Application.ScreenUpdating = False
    Dim rng As Range
    For Each rng In Range("E4:E15")
        If rng = "" Then
            Range("D" & rng.Row + 1 & ":F15").Cut Range("D" & rng.Row)
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

Uh oh, one last question, my cells are formatted to have white borders. After running the macro, the gray lines become visible and formulas using that data are impacted. Any way we can have the shift upwards but retain the white border formatting and does not impact formulas linked to the cells? Almost like a clear content

 

[mumps]

It would be easier to help and test possible solutions if you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).