Sort listbox range ascending each time its updated 1

[Epsilon101]

Hi,
Spot of bother with this, can anyone help? its in Excel.
I have a userform called FrmMaintenance.

It has 4 option buttons:
OptTitle
OptPassed
OptAbility
OptReason

A textbox:
TxtAdd

A Listbox:
Listbox1

3 buttons:
CmdAdd
CmdDelete
CmdOk

The idea of it is, the option buttons update the listbox with data from a different worksheet each time they are clicked. While an option is clicked, you type something into 'TxtAdd' and click the 'CmdAdd' button to add it to the bottom of the range and then the listbox updates again. Also got a 'CmdDelete' button to delete any selected data in the listbox. They are all password protected, and when writing or deleting from them i am removing the password and then adding it again.

Sheets of data:
'PassedTo'
'Reasons'
'Ability'
'Titles'

This section is FrmMaintenance code:

Private Sub UserForm_initialize()
OptTitle = True
TxtAdd.Value = ""
TxtAdd.SetFocus

End Sub

Private Sub UserForm_Terminate()
Unload Me
End Sub

Private Sub cmdAdd_Click()
    With ws
        .Unprotect ("password")
        .Range("A" & LRow + 1) = Me.TxtAdd.Text
        .Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
        LRow = GetLastRow(.Name)
        ListBox1.Clear
        ListBox1.List = .Range("A1:A" & LRow).Value
    End With
End Sub


Private Sub cmdDelete_Click()
Dim c As Range
    With ws
        Set c = .Range("A1:A" & LRow).Cells.Find(Me.ListBox1.Value, , , xlWhole, xlByRows)
        If Not c Is Nothing Then
            .Unprotect ("password")
            c.Delete xlUp
            .Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
            LRow = GetLastRow(.Name)
            ListBox1.Clear
            ListBox1.List = .Range("A1:A" & LRow).Value
        Else
            MsgBox "No Data selected!", vbCritical
        End If
    End With
End Sub

Private Sub OKButton_Click()
    Unload Me
End Sub

Private Sub optReason_Click()
    Call UpdateListBox("Reasons")
End Sub

Private Sub optAbility_Click()
    Call UpdateListBox("Ability")
End Sub

Private Sub optPassed_Click()
    Call UpdateListBox("PassedTo")
End Sub

Private Sub optTitle_Click()
    Call UpdateListBox("Titles")
End Sub

This section is my module:

Option Explicit
'Declarations
Public LRow As Long
Public ws As Worksheet
Public gPassword As String


Function GetLastRow(sh As String) As Long
GetLastRow = ThisWorkbook.Worksheets(sh).Range("A65536").End(xlUp).Row
End Function

Sub UpdateListBox(sh As String)
'also updates variables for sheet & row
Set ws = ThisWorkbook.Worksheets(sh)
    With ws
        LRow = GetLastRow(.Name)
        FrmMaintenance.ListBox1.Clear
        FrmMaintenance.ListBox1.List = .Range("A1:A" & LRow).Value
    End With
End Sub

I also tried adding the below to the command buttons 'add' and 'delete' for updating the sort while the password is off, but it came back with errors.

Private Sub cmdAdd_Click()
    With ws
        .Unprotect ("password")
        .Range("A" & LRow + 1) = Me.TxtAdd.Text
        [COLOR=red].Range("A1:A" & LRow).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal[/color]
        .Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
        LRow = GetLastRow(.Name)
        ListBox1.Clear
        ListBox1.List = .Range("A1:A" & LRow).Value
    End With
End Sub

Thanks for any help

---------------------------------------

Neil

 

[Loomah]

Hi Neil
It probably would've helped if you had said what error you were getting!

I've tried recreating the whole thing as you have it but using the sort code you have as well. I too got errors depending on which sheet was active at the time.

You need to add a dot in the key1:=Range etc before range

Substitute this little bit for the first part of you sort code and let me know if that fixes the problem. Note that I have also ammended the range to sort as it was missing bits before!

.Range("A:A").Sort Key1:=[b][COLOR=red].[/color][/b]Range("A1")

Happy Friday

;-)

If a man says something and there are no women there to hear him, is he still wrong?
How do I get the best answers?​

 

[Epsilon101]

Hiya Loomah, sorry about the error, i got it at home last night and i didnt have time to re-test this morning so couldnt remember what it said.

Thanks for your help on this.
There is something else on this you might be interested in making even better.

There is an error if the data going on to the listbox is 1 item or less.

I wasnt going to mention it because its no biggy because most lists will always have more than 1 item, but there is always the possibility.

it because of ListBox1.List = .Range("A1:A" & LRow).Value

with is being A1:A & LRow, so it does A1:A1 for a range and just goes BLEH!!

Thanks again for your help Loomah


---------------------------------------

Neil

 

[Epsilon101]

Here we go, this is what ive got for these 2 command buttons.

So now it unprotects adds the info to the sheet clears listbox, sorts it with the new info and then protects it again, as you can see below.

All because of a bleeding .
Thanks

Private Sub cmdAdd_Click()
    With ws
        .Unprotect ("password")
        .Range("A" & LRow + 1) = Me.TxtAdd.Text
        LRow = GetLastRow(.Name)
        ListBox1.Clear
        .Range("A1:A" & LRow).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        ListBox1.List = .Range("A1:A" & LRow).Value
        .Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
    End With
End Sub


Private Sub cmdDelete_Click()
Dim c As Range
    With ws
        Set c = .Range("A1:A" & LRow).Cells.Find(Me.ListBox1.Value, , , xlWhole, xlByRows)
        If Not c Is Nothing Then
            .Unprotect ("password")
            c.Delete xlUp
            LRow = GetLastRow(.Name)
            ListBox1.Clear
            .Range("A1:A" & LRow).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:= _
            xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
            ListBox1.List = .Range("A1:A" & LRow).Value
            .Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
        Else
            MsgBox "No Data selected!", vbCritical
        End If
    End With
End Sub

---------------------------------------

Neil

 

[Loomah]

Hi again Neil
I haven't tested this as the file I created I didn't save and I then had a little "accident"!!

My first thought would be to check the value of LRow and add items accordingly
eg
if lrow >1 then
ListBox1.List = .Range("A1:A" & LRow).Value
else
ListBox1.additem .Range("A1").Value
end if

Happy Friday

;-)

If a man says something and there are no women there to hear him, is he still wrong?
How do I get the best answers?​