Deleting cells and moving subsequent cells up

[Moonbeam111]

I have a cells that look like something like this

Number 1	Word 1
Number 2	Word 2
Number 3	Word 3
Number 4	Word 4

I am trying to create a macro that will essentially delete the cells "Number 1" and "Word 1" in Range("G91:H91") and moves/copies the rest of the cells up 1 row. "Number 2" and "Word 2" would get placed where "Number 1 and Word 1" were etc...

I wrote this but it sometimes does not work. Is there a better alternative? The idea seems simple enough but I am having trouble.

If Range("G92") <> "" Then
Sheets("Sheet1").Range("G91:H91", Sheets("Sheet1").Range("G91").End(xlDown)).Copy
Else:  Sheets("Sheet1").Range("G91:H91").Copy
End If
 
 
 Sheets("Sheet1").Range("G90:H90").PasteSpecial xlValues
 If Range("G90") = "" Then GoTo skiptothere
 Sheets("Sheet1").Range("G150").End(xlUp).ClearContents
 Sheets("Sheet1").Range("H150").End(xlUp).ClearContents
skiptothere:

 

[coulombevin]

Hi moonbeam,

Try this:

Sub rmGH90AndMoveUp()
    Dim lstRow As Long
    With Sheets("Sheet1")
        'Find last row
        lstRow = .Range("G1048576").End(xlUp).Row
        'Not supposed to be under 90?
        If lstRow > 90 Then
            'Take the range above cut and put it over G90-H90
            .Range("G91:H" & lstRow).Cut (.Range("G90"))           
        End If       
    End With
End Sub

bests regards,

Vincent

 

[Moonbeam111]

Thank you. That works pretty well.

Do you have a solution that does not use the "cut" option? I have a formula that depends on a cell in G90 and when it gets cut, the formula loses its reference and becomes REF#!.

 

[coulombevin]

Thank you. That works pretty well.

Do you have a solution that does not use the "cut" option? I have a formula that depends on a cell in G90 and when it gets cut, the formula loses its reference and becomes REF#!.

Hi Moonbeam,

Here's how I would do it by only changing the value of the cell:

Sub rmGH90AndMoveUp_V2()
    Dim lstRow As Long
    Dim i As Long
   
    With Sheets("Sheet1")
        'Find last row
        lstRow = .Range("G1048576").End(xlUp).Row
        'Not supposed to be under 90?
        If lstRow > 90 Then
            i = 91
            For i = 91 To lstRow
                'Loop row 91 to last and every time take the value of actual row and put it one row above
                .Range("G" & i - 1).Value = .Range("G" & i).Value
                .Range("H" & i - 1).Value = .Range("H" & i).Value
            Next i
            'Remove value from last row without formating
            .Range("G" & lstRow).Value = ""
            .Range("H" & lstRow).Value = ""
        End If
    End With
End Sub

the code above will keep the value of row 90 if nothing is found in row 91, but if you only have value in row 90 left and want to remove it, you have to put out .range.value = "" from the if like so:

Sub rmGH90AndMoveUp_V2()
    Dim lstRow As Long
    Dim i As Long
   
    With Sheets("Sheet1")
        'Find last row
        lstRow = .Range("G1048576").End(xlUp).Row
        'Not supposed to be under 90?
        If lstRow > 90 Then
            i = 91
            For i = 91 To lstRow
                'Loop row 91 to last and every time take the value of actual row and put it one row above
                .Range("G" & i - 1).Value = .Range("G" & i).Value
                .Range("H" & i - 1).Value = .Range("H" & i).Value
            Next i
        End If
        'Remove value from last row without formating
        .Range("G" & lstRow).Value = ""
        .Range("H" & lstRow).Value = ""
    End With
End Sub

Bests regards,

Vincent

 

[Moonbeam111]

Brilliant. The second code is exactly what I needed. Thank you very much.

 

[MARK858]

Just a non-looping version to try

Sub Moonbeam111delUp()
    Dim lstRow As Long
   
    With Sheets("Sheet1")
        'Find last row
        lstRow = .Range("G" & .Rows.Count).End(xlUp).Row
        'Not supposed to be under 90?
        If lstRow > 90 Then
            .Range("G90:H" & lstRow - 1).Value = .Range("G91:H" & lstRow).Value
        End If
        'Remove value from last row without formating
        .Range("G" & lstRow).Resize(, 2).Value = ""
  
    End With
End Sub

 

[Peter_SSs]

A very slight modification of the non-looping version would remove the requirement to separately clear the old last row

Sub Moonbeam111delUp_v2()
    Dim lstRow As Long
   
    With Sheets("Sheet1")
        'Find last row
        lstRow = .Range("G" & .Rows.Count).End(xlUp).Row
        'Not supposed to be under 90?
        If lstRow > 90 Then
            .Range("G90:H" & lstRow).Value = .Range("G91:H" & lstRow + 1).Value
        End If
    End With
End Sub