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......
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