A
ArnoldHatCGI
Guest
'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 VBA Excel Error Handling - especially in functions - Professional Excel Development Style
If bCentralErrorHandler(msMODULE, sSOURCE, , True) Then
Stop
Resume
Else
Resume ErrorExit
End If
End Function
Continue reading...
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 VBA Excel Error Handling - especially in functions - Professional Excel Development Style
If bCentralErrorHandler(msMODULE, sSOURCE, , True) Then
Stop
Resume
Else
Resume ErrorExit
End If
End Function
Continue reading...