Delete cell in worksheet based on selected Row in Listbox

[zubin]

Hi everyone....
I Have a userform with a listbox which is populated with row source property.

After selecting a row in the Userform, A delete Key should remove the selected Row in the list box and the corresponding worksheet cell values in the range "B4 to B14" and "E4 to E14"
and cells values below (If at all present) these should shift up...... and NOT the whole column.

I am so far able to delete only values from one column ie "B" and that too the whole column beyond "B14" shifts up, this should not happen as there is another table below this range.

Columns "C", "D" and "F" in the worksheet Range B4:F17 have formulas and are populated as per the values of Column "B" and "E".
Currently I am using this code.....

Please Help....

Private Sub CommandButton1_Click()
Unload Me
End Sub

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
          
         End If
        
    Next i

End Sub

Book1.xlsm
	A	B	C	D	E	F	G	H	I
1
2
3	S.No.	BarCode	Item	Unit Price	Qty.	Total
4		2			8
5		3			3
6		2			5
7		5			4
8		5			3
9		3			2
10		2			1
11		3			2
12		8			9
13		7			8
14
15
16
17
18
19
20		58			2
21		8			7
22		7			8
23		8			9
24		9			7
25		6			8
26		1			5
27		8			2
28
29
30
31
Sheet1

 

[zubin]

Correction :

Call subDeleteAndMoveUp(ActiveSheet.Range("B" & intRow))

Your Question.....(When the Delete button is selected how do you ascertain the appropriate row number.?)
I am not sure...but something like...

For i = 0 To Me.ListBox1.ListCount - 1    
        If Me.ListBox1.Selected(i) = True Then

Please give me the correct form.....of putting this statement

 

[zubin]

Your Question.....(When the Delete button is selected how do you ascertain the appropriate row number.?)
I am not sure...but something like...

For i = 0 To Me.ListBox1.ListCount - 1   
        If Me.ListBox1.Selected(i) = True Then

Please give me the correct form.....of putting this statement

Initially I was using the below code, but this way all the cell values below the range B14 are also shifted up,

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
          
         End If
        
    Next i

End Sub

 

[Herakles]

So substitute your code for this :

I've just added in the function calls for columns Band E and commented out the line
Range("B" & i + 4).Delete Shift:=xlUp

Let me know if this does the job.

Use a copy of the data though.

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

 

[zubin]

So substitute your code for this :

I've just added in the function calls for columns Band E and commented out the line
Range("B" & i + 4).Delete Shift:=xlUp

Let me know if this does the job.

Use a copy of the data though.

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

Thanks for your time Herakles......Its working beautiful.....minor changes needed...
1. The row below the selected row is getting deleted,
2. and say for example there are 7 rows filled from top ie B4:B10 and E4:E10 and say i select any row from the last 3 rows ie row 8,9 or 10 then all other data below the 14th row is getting pulled up otherwise every thing is fine.

 

[zubin]

Thanks for your time Herakles......Its working beautiful.....minor changes needed...
1. The row below the selected row is getting deleted,
2. and say for example there are 7 rows filled from top ie B4:B10 and E4:E10 and say i select any row from the last 3 rows ie row 8,9 or 10 then all other data below the 14th row is getting pulled up otherwise every thing is fine.

Ok sorry... the first problem was an error in the named range.....It was "=Sheet1!$B$3:$F$17" instead of "=Sheet1!$B$4:$F$17" Now the selected row is being deleted correctly.
But However the second problem is still persisting.

 

[zubin]

Ok sorry... the first problem was an error in the named range.....It was "=Sheet1!$B$3:$F$17" instead of "=Sheet1!$B$4:$F$17" Now the selected row is being deleted correctly.
But However the second problem is still persisting.

Also I realized that if there is any value in cells B16 to B18 and E16 to E18 are also been pulled up irrespective of which row i am deleting....

 

[zubin]

Also I realized that if there is any value in cells B16 to B18 and E16 to E18 are also been pulled up irrespective of which row i am deleting....

In short....No value present in cells 15th row and below should get pulled up

 

[Herakles]

This should fix the problem.

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

 

[zubin]

This should fix the problem.

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

Herakles.....I don't know how to thank you, Perfect...the way i wanted and even better.
Problem solved'
Thanks a Ton

 

[Herakles]

Finding the last non-blank cell in a range proved to be unreliable using suggested methods hence the loop.

Another option would have been to clear the range and re-write it by looping through the unselected items in the listbox.