Inserting/Deleting Row (VBA)

[Mr_Calvin]

Hi guys,

I need assistance in the following two VBAs coding.

This is the excel worksheet that I need help with.

1) This is the current coding that I have for delete(empty cells)

Sub delRowsGO()
Application.ScreenUpdating = False
Dim txtCel As Range
Set txtCel = Columns(2).Find(what:="Supported by SO Finance")
txtCel.Offset(-1).EntireRow.delete
End Sub

I need to enhance the coding whereby it can delete the rows above row(17) and error pop up when it reaches B14:D14? My current coding works, but there's no stop to the deleting rows.

2) Next, Inserting Row Coding.

Sub insertRowsGO()
Dim txtCel As Range
Set txtCel = Columns(2).Find(what:="Supported by SO Finance")
txtCel.Offset(-1).EntireRow.Insert Shift = xlDown, CopyOrigin:=xlFormatFromRightOrAbove
End Sub

This is a little different, when I press insert row, the row inserted is not right above row(17), instead is inserted between current row(15)/(16) and the formal row(16) will escalate down to row(17).

Help is much appreciated. Please and thanks.

 

[Fazza]

hello

that image is helpful to some extent - though it can't be copied usefully into excel. so I haven't test this.
anyway, these will give the idea & please modify as required

Sub delRowsGO()
    Application.ScreenUpdating = False
    Dim txtCel As Range
    Set txtCel = Columns(2).Find(what:="Supported by SO Finance")
    With txtCel.Offset(-1)
        If IsNumber(.Value2) Then
            txtCel.Offset(-1).EntireRow.Delete
        Else
            MsgBox "no more rows to delete"
        End If
    End With
End Sub

for the second question, try deleting the ".offset(-1)"

regards

 

[Mr_Calvin]

Hi fazza,

For the first question, the with and else there's error.

The second question I tried removing ".offset(-1)", my initial format will be gone. It will follow row(17) instead of row(16).

Sorry I'm very new to excel but and really need assistance. Thank you very much.

 

[Fazza]

I can't readily help as I can't copy that image into Excel to check the set up. I'm not interested in guessing what you've got &, without knowing the details, recreating something from scratch that may not match what you have. (Whereas if I could copy & paste into Excel I would.)

I'm guessing there are merged cells. If so, please remove all merged cells & try again. FWIW, I'd recommend you never use merged cells.

If you want further help, suggest you investigate how to paste worksheet extracts into forum posts. There will be sticky posts explaining it.

regards

PS. If there are merged cells, I won't offer further advice: I'm not interested in working with merged cells.

 

[rlv01]

I'm basing this off of your screen shot, so you may need to adjust it.


Insert a row at the end of the table

Sub insertRowsGO()
    Dim WS As Worksheet
    Dim RangeOfCells As Range
    Dim TM As Range, BM As Range
    Dim TopMarker As String, BottomMarker As String

    Set WS = ActiveSheet
    If WS.AutoFilterMode Then
        WS.AutoFilterMode = False
    End If

    TopMarker = "List of Items (Please Fill In)"
    BottomMarker = "Supported by SO Finance"

    Set TM = WS.UsedRange.Find(what:=TopMarker, LookAt:=xlWhole)
    Set BM = WS.UsedRange.Find(what:=BottomMarker, LookAt:=xlWhole)
    Set RangeOfCells = WS.Range("B" & TM.Row + 1 & ":B" & BM.Row - 1)

    'Insert Row
    BM.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Set RangeOfCells = RangeOfCells.Resize(RangeOfCells.Rows.Count + 1)

    'Re-number
    With RangeOfCells
        Debug.Print .Address
        .ClearContents
        .Range("A1").Value = 1
        .DataSeries Rowcol:=xlColumns
    End With
End Sub

Delete empty rows

Sub delRowsGO()
    Dim WS As Worksheet
    Dim FilterRange As Range
    Dim DataRange As Range
    Dim TM As Range, BM As Range
    Dim DeleteRange As Range
    Dim TopMarker As String, BottomMarker As String

    TopMarker = "List of Items (Please Fill In)"
    BottomMarker = "Supported by SO Finance"

    Set WS = ActiveSheet
    Set TM = WS.UsedRange.Find(what:=TopMarker, LookAt:=xlWhole)
    Set BM = WS.UsedRange.Find(what:=BottomMarker, LookAt:=xlWhole)
    Set FilterRange = WS.Range("B" & TM.Row & ":B" & BM.Row - 1)
    Set DataRange = WS.Range("B" & TM.Row + 2 & ":B" & BM.Row - 1)

    If WS.AutoFilterMode Then
        WS.AutoFilterMode = False
    End If

    If DataRange.Range("A1").Value <> 2 Then
        Exit Sub    'don't delete the first row, even if empty
    End If

    'Delete Blank Rows
    Application.ScreenUpdating = False
    FilterRange.Offset(, 1).AutoFilter Field:=1, Criteria1:=""
    Set DeleteRange = Application.Intersect(FilterRange.SpecialCells(xlCellTypeVisible).EntireRow, DataRange.EntireRow)

    If WS.AutoFilterMode Then
        WS.AutoFilterMode = False
    End If

    If Not DeleteRange Is Nothing Then
        DeleteRange.Delete    'delete blank rows

        Set BM = WS.UsedRange.Find(what:=BottomMarker, LookAt:=xlWhole)
        Set DataRange = WS.Range("B" & TM.Row + 2 & ":B" & BM.Row - 1)

        If DataRange.Range("A1").Value <> 1 Then
            'Re-number
            With DataRange
                .ClearContents
                .Range("A1").Value = 2
                .DataSeries Rowcol:=xlColumns
            End With
        End If
    End If
    Application.ScreenUpdating = True
End Sub