how to updates multiple rows in muliselect listbox

[jaym6939]

Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code lstDatabase.List(0, 4). i am looking to add loop count or list index to update multiple rows by command button.
can you pl help with to update below code?

Private Sub cmdaction_Click()
Dim i As Long, n As Long, f As Range


Dim t, t1 As String
If cmbaction.Value = "RP" Then
t = Chr(Asc(Mid(lstDatabase.List(0, 4), 2, 1)) + 1)
'Me.lstDatabase.Row (0), Column(4) = "ABA"
t1 = Mid(lstDatabase.List(0, 4), 1, 1) & t & Mid(lstDatabase.List(0, 4), 3, 1)
Me.lstDatabase.List(0, 4) = t1

End If

End Sub

thanks

 

[jaym6939]

So it already works for you?

Sorry .only half of the code is working .I am able to get text "Deleted" @ intersection of column and row. But unable to strikthrough selected row....if you help to creat code for that??
Thanks

 

[DanteAmor]

Sorry, I'm not understanding now what you need.
I guess you keep modifying the code that I made. But if you don't put the new code here I can't guess what the problem is.
You can share your book again, you explain to me what does not work, that is, what data should I select in userform and what the code should do.

 

[jaym6939]

Sorry for confusion. your code work as per requirement. i am trying to extend the code you have provided to suit specific function for my use. what i am looking for is to add code to strike through selected row in database (Part bump) when user select DP drop down option from cmbaction box.
below all code works,

If .Selected(i) = True Then
      selItem = UserForm3.lstDatabase.List(i, 4)
      Set vrech = sh.Range("E3:E250").Find(.Column(4, i), , xlValues, xlWhole)
        If cmbaction.Value = "RP" Then
          
          'If Not vrech Is Nothing Then
            t = Chr(Asc(Mid(.List(i, 4), 2, 1)) + 1)
            'Me.lstDatabase.Row (0), Column(4) = "ABA"
            t1 = Mid(.List(i, 4), 1, 1) & t & Mid(.List(i, 4), 3, 1)
            Intersect(vrech.EntireRow, lColumn.EntireColumn) = t1
        ElseIf cmbaction.Value = "RV" Then
            Intersect(vrech.EntireRow, lColumn.EntireColumn) = selItem

Need help to strikthrough selected row when user select DP from drop down combo box.

 ElseIf cmbaction.Value = "DP" Then
           Intersect(vrech.EntireRow, lColumn.EntireColumn) = "Deleted":  'And  (looking for code that strikthrough selected row in database)

Please find below updated file with additional codes.
Test Dummy (1).xlsm

 

[DanteAmor]

Need help to strikthrough selected row

Try this

Private Sub cmdaction_Click()
  Dim t, t1 As String
  Dim vrech As Range, lColumn As Range
  Dim sh As Worksheet
  Dim i As Long
  Dim selItem As String
  
  Set sh = ThisWorkbook.Sheets("part bump")
  Set lColumn = sh.Range("H1:AZA1").Find(Val(txtchangenumber.Value), , xlValues, xlWhole)
  If lColumn Is Nothing Then
    MsgBox "Column not found"
    Exit Sub
  End If
  
  With UserForm3.lstDatabase
    For i = 0 To .ListCount - 1
    
      If .Selected(i) = True Then
        Set vrech = sh.Range("E3:E250").Find(.Column(4, i), , xlValues, xlWhole)
        If Not vrech Is Nothing Then
          Select Case cmbaction.Value
            Case "RP"
              t = Chr(Asc(Mid(.List(i, 4), 2, 1)) + 1)
              'Me.lstDatabase.Row (0), Column(4) = "ABA"
              t1 = Mid(.List(i, 4), 1, 1) & t & Mid(.List(i, 4), 3, 1)
              Intersect(vrech.EntireRow, lColumn.EntireColumn) = t1
          Case "RV"
            Intersect(vrech.EntireRow, lColumn.EntireColumn) = .List(i, 4)
          Case "DP"
            Intersect(vrech.EntireRow, lColumn.EntireColumn) = "Deleted"
            vrech.EntireRow.Font.Strikethrough = True
          End Select
        End If
      End If
      
    Next i
  End With
End Sub

 

[DanteAmor]

But it is important that you do not remove the validations, otherwise it will send you an error.

'If Not vrech Is Nothing Then

 

[jaym6939]

But it is important that you do not remove the validations, otherwise it will send you an error.

'If Not vrech Is Nothing Then

Thanks heaps..I will try it..

 

[DanteAmor]

Thanks heaps..I will try it..

I hope you do it, because it seems competition, me to put and you to remove, I am going to lose, but in the end the one who loses is you, it is your development and later you will have problems.

 

[jaym6939]

Hi DanteAmor,
thanks for your help. the above solution works for test dummy file with intended out come. when i try to apply same code to master file, it only update 1st selected column. can you pl help to correct code to update all selected listbox rows. Below is code i have used for master file,

Private Sub cmdaction_Click()

  Dim t, t1 As String
  Dim vrech As Range, lColumn As Range
  Dim sh As Worksheet
  Dim i As Long
  Dim selItem As String
 
  Set sh = ThisWorkbook.Sheets("part bump")
  Set lColumn = sh.Range("P1:AZA1").Find(Val(txtchangenumber.Value), , xlValues, xlWhole)
  'Set lcolumn1 = sh.Range("F4:F1000")
 
  If UserForm3.txtchangedescrption.Value = "" Then
    MsgBox "Please enter Change Description"
    Exit Sub
    End If
If UserForm3.txtchangenumber.Value = "" Then
    MsgBox "Please enter Change Number"
    Exit Sub
    End If
  If UserForm3.cmbaction.Value = "" Then
    MsgBox "Please Select part Action"
    Exit Sub
    End If
 
  If lColumn Is Nothing Then
    MsgBox "Change number not found"
    Exit Sub
  End If
 
 
  With UserForm3.lstDatabase
    For i = 0 To UserForm3.lstDatabase.ListCount - 1
      If UserForm3.lstDatabase.Selected(i) = True Then
        Set vrech = sh.Range("H4:H250").Find(.Column(7, i), , xlValues, xlWhole)
        If Not vrech Is Nothing Then
          Select Case cmbaction.Value
            Case "RP"
              t = Chr(Asc(Mid(.List(i, 7), 2, 1)) + 1)
               t1 = Mid(.List(i, 7), 1, 2) & t & Mid(.List(i, 7), 4, 1)
              Intersect(vrech.EntireRow, lColumn.EntireColumn) = t1
              MsgBox "Selected parts 'RP' Action completed"
          Case "RV"
            Intersect(vrech.EntireRow, lColumn.EntireColumn) = .List(i, 7)
            MsgBox "Selected parts 'RV' Action completed"
          Case "DP"
            Intersect(vrech.EntireRow, lColumn.EntireColumn) = "Deleted"
            vrech.EntireRow.Font.Strikethrough = True
            MsgBox "Selected parts 'DP' Action completed"
        
          End Select
        End If
      End If
     
    Next i
   
  End With
End Sub

 

[DanteAmor]

Sorry that I can't continue helping, but as I mentioned in post #27, I put a code and you modify it, example:

My code:

 With UserForm3.lstDatabase
    For i = 0 To .ListCount - 1
      If .Selected(i) = True Then
        Set vrech = sh.Range("E3:E250").Find(.Column(4, i), , xlValues, xlWhole)
        If Not vrech Is Nothing Then

Your code:

 With UserForm3.lstDatabase
    For i = 0 To UserForm3.lstDatabase.ListCount - 1
      If UserForm3.lstDatabase.Selected(i) = True Then
        Set vrech = sh.Range("H4:H250").Find(.Column(7, i), , xlValues, xlWhole)
        If Not vrech Is Nothing Then

 

[jaym6939]

DanteAmor,
thanks for your constant help and support. and sorry to modified your code as i have huge data master file that i need to work on. Hence i need to modified your code to suit Master file. after yesterday's digging around for this issue, i have found issue with Listbox rowsource code not with above mention code. if you dont mind, can you pl guide me how can i increase number of column display under listbox? as per your suggested code, it only allows me to get column A to F. where i need to add column A to K with header in listbox.
thanks for your support and guidance.

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("part bump")

Dim Last_Row As Long
Dim r, c As Range

Last_Row = Application.WorksheetFunction.CountA(sh.Range("A:A"))

With UserForm3
              

        '.lstDatabase.ColumnCount = 11
        '.lstDatabase.ColumnHeads = True
       ' .lstDatabase.ColumnWidths = "20,40,40,40,2,60,60,60,60,300,60"
        .lstDatabase.ColumnCount = 10
        .lstDatabase.ColumnHeads = True
        .lstDatabase.ColumnWidths = "40,60,60,60,60,100,100"
     Set r = sh.Range("A4:F" & Last_Row)
     
     i = 0
     For Each d In r.Rows
     j = 0
    For Each c In d.Cells
    UserForm3.lstDatabase.AddItem
     
     UserForm3.lstDatabase.List(i, j) = c.Value
     j = j + 1
     
     Next c
     i = i + 1
     Next d
     
    If Last_Row = 1 Then
        UserForm3.lstDatabase.RowSource = "part bump!A4:F4"
        
      End If
        
End With