how to updates multiple rows in muliselect listbox

jaym6939

New Member
Joined
Jun 26, 2020
Messages
43
Office Version
  1. 365
Platform
  1. Windows
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?

VBA 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

New Member
Joined
Jun 26, 2020
Messages
43
Office Version
  1. 365
Platform
  1. Windows
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
 

Some videos you may like

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
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

New Member
Joined
Jun 26, 2020
Messages
43
Office Version
  1. 365
Platform
  1. Windows
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,
VBA Code:
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.
VBA Code:
 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

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
Need help to strikthrough selected row

Try this
VBA Code:
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
 
Last edited:

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

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

'If Not vrech Is Nothing Then
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

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

New Member
Joined
Jun 26, 2020
Messages
43
Office Version
  1. 365
Platform
  1. Windows
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,

VBA Code:
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

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
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:
VBA 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:
VBA 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

New Member
Joined
Jun 26, 2020
Messages
43
Office Version
  1. 365
Platform
  1. Windows
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.
VBA Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,108,938
Messages
5,525,734
Members
409,661
Latest member
pprabha

This Week's Hot Topics

Top