Hi Everyone......Due to the current lock down I am having plenty of time modifying my workbook.....
The following code is supposed to delete the selected Rows in the userform listbox from column "B" and Column "E" in the range ie B4:B14 and E4:E14 and shift the remaining cells up.
Column "B" works fine ....problem is with Column "E" the last row in this column gets deleted instead of the selected row
and please note there other tables and data beyond and below row number 14......so all deleting and shifting up should be done in this range only ie B4:B14 and E4:E14
If you run the attached workbook sample with the codes the problem will be noticed.
To modify this code is beyond my understanding......
Code
Private Sub CommandButton2_Click()
Dim i As Long
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) = True Then
' Range("B" & i + 4).Delete Shift:=xlUp
Call subDeleteAndMoveUp(ActiveSheet.Range("B" & i + 4))
Call subDeleteAndMoveUp(ActiveSheet.Range("E" & i + 4))
End If
Next i
End Sub
Public Sub subDeleteAndMoveUp(rngToDelete As Range)
Dim rng As Range
Dim intlastRow As Integer
Dim i As Integer
intlastRow = 14
For i = 1 To 11
If IsEmpty(Cells(i + 3, rngToDelete.Column)) Then
intlastRow = i + 3 - 1
Exit For
End If
Next i
Set rng = Cells(4, rngToDelete.Column).Resize(intlastRow - 3, 1)
If rngToDelete.Row = intlastRow Then
rngToDelete.Value = ""
Else
Set rng = Cells(4, rngToDelete.Column).Resize(intlastRow - 3, 1).Range(rng.Cells(rngToDelete.Row - 5, 0), rng.Cells(8, 0))
rng.Offset(-1, 0).Value = rng.Value
Cells(intlastRow, rngToDelete.Column).Value = ""
End If
End Sub
Display More