locked
VBA, excel : deleting/inserting rows , no errors, no result RRS feed

  • Question

  • 'VBA, Excel deleting/inserting rows , no errors, no result 
    
    Function TableResizeInRows(SheetName As String, TableName As String, NumberDataRows As Integer) As String
    'NO ERROR BUT ALSO NO RESULT
    Dim l_Tableref As ListObject
    Dim l_SheetName As Worksheet
    Dim l_range As Range
    Dim l_ListRows As ListRows
    Dim MyNewRow As ListRow
    Dim c_ListRows As Long
    Dim InsertIndex As Integer
    Dim DeleteIndex As Integer
    Dim HeaderIsOnRow As Integer
    Dim StartWsRow As Integer
    Dim EndWsRow As Integer
    On Error GoTo ErrorHandler
    
    If (NumberDataRows < 2) Then
        TableResizeInRows = "Row 1 not to be deleted, formulas will be deleted too!"
        Exit Function
    End If
    
    Set l_SheetName = Worksheets(SheetName)
    ' make goal-worksheet active (set correct context)
    l_SheetName.Activate
    ' Define Table Object
    Set l_Tableref = Sheets(SheetName).ListObjects(TableName)
    ' determine # rows in listobject
    Set l_ListRows = l_Tableref.ListRows
    c_ListRows = l_Tableref.ListRows.Count
    ' determine rownumber on which the table is
    HeaderIsOnRow = Sheets(SheetName).ListObjects(TableName).HeaderRowRange.Row
    ' Now we have sheet-rows that should be deleted/inserted
    If (c_ListRows > NumberDataRows) Then
                    ' We have to delete rows but it should be (the last row) of the listobject (Table)
                    ' EndWsRow = last row that is to be deleted (lowest row#)
        EndWsRow = (HeaderIsOnRow + NumberDataRows) + 1
                    ' StartWsRow = First row that is to be deleted (highest row#)
        StartWsRow = HeaderIsOnRow + c_ListRows
        For DeleteIndex = StartWsRow To EndWsRow Step -1
    'NO ERROR BUT ALSO NO RESULT
    '        Set l_range = l_SheetName.Range("A" & DeleteIndex)
    '        Range("A" & DeleteIndex).EntireRow.Delete
            Worksheets(SheetName).Rows(DeleteIndex).Delete
            'l_Tableref.ListRows(DeleteIndex - HeaderIsOnRow).Delete 'Based on row in table 'results in error 1004
        Next
        TableResizeInRows = "Success, rows deleted?"
        Exit Function
    Else
        If (c_ListRows < NumberDataRows) Then
                    ' We must insert directly below the listobject (Table)
                    ' StartWsRow = Last row of table after which a row is to be inserted(so last rownumber on sheet that contains tablerow)
            StartWsRow = HeaderIsOnRow + c_ListRows
                    ' EndWsRow = Last row after which one more row is to be inserted
            EndWsRow = (HeaderIsOnRow + NumberDataRows) - 1
            For InsertIndex = StartWsRow To EndWsRow Step 1
    'NO ERROR BUT ALSO NO RESULT
                Worksheets(SheetName).Rows(InsertIndex).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Next
            TableResizeInRows = "Success, rows inserted?"
            Exit Function
        End If
    End If
    TableResizeInRows = "Result unknown"
    Exit Function
    
    ErrorExit:
        On Error Resume Next
        Exit Function
    
    ErrorHandler:
    ' Public Function bCentralErrorHandler
    ' see https://stackoverflow.com/questions/19042604/vba-excel-error-handling-especially-in-functions-professional-excel-developm
        If bCentralErrorHandler(msMODULE, sSOURCE, , True) Then
            Stop
            Resume
        Else
            Resume ErrorExit
        End If
    End Function

    Monday, June 22, 2020 11:56 AM

Answers

  • Sorry, had to try, all VBA forums are closed due to migration, and I was referred to this opportunity.
    • Marked as answer by ArnoldHatCGI Monday, June 22, 2020 12:10 PM
    Monday, June 22, 2020 12:10 PM

All replies

  • Hi

    This is a Forum for VB.NET, not VBA or excel.


    Regards Les, Livingston, Scotland

    Monday, June 22, 2020 11:58 AM
  • Sorry, had to try, all VBA forums are closed due to migration, and I was referred to this opportunity.
    • Marked as answer by ArnoldHatCGI Monday, June 22, 2020 12:10 PM
    Monday, June 22, 2020 12:10 PM