Showing items names from database into listbox

[devatu]

Hey all,

I would like to show items from my database into my listbox. But In my database, some items have a duplicate name, and I want to show everything in my listbox as if it got only one copy of it. I.E., I have in my database column 2, "test" and "test", I don't want my listbox to show "test" and "test", but just one single "test".

I've got the following code till now:

Private Sub RefreshListbox()
    Dim rs As Object
    Dim sqlstr As String
    Dim Partname As String
    Dim Recordcount As Long
    Dim Recordvalue As Long
    Dim Data As Variant
    Dim continuevalue As String
    Dim rs_old As String
    Dim rs_new As String

    Set rs = CreateObject("ADODB.Recordset")
    Set rs2 = CreateObject("ADODB.Recordset")
    sqlstr = "SELECT * FROM [Tabel1]"

    Call connectDatabase

    rs.Open sqlstr, DBCONT
    rs2.Open sqlstr, DBCONT
    Recordcount = rs.Recordcount
    Recordcount2 = rs2.Recordcount
    Recordvalue = Recordcount - 1
    ListBox1.ColumnCount = 8

    On Error Resume Next
    While Not rs.EOF
        ReDim Data(1 To Recordcount2, 1 To 7)
        rs_old = rs(2)
        rs.movenext
        rs_new = rs(2)
        While rs_new = rs_old And Not rs.EOF = True
            counter = counter + 1
            rs_old = rs(2)
            rs.movenext
            rs_new = rs(2)

        Wend
        If counter >= 1 Then

            Data(rs2.absoluteposition, 2) = rs2(2)
            rs2.movenext
        Else

            Data(rs2.absoluteposition, 2) = rs2(2)
            rs2.movenext
        End If

    Wend

    rs.Close
    rs2.Close
    Call closeDatabase

End Sub

And refresh listbox is called in the userform_initialize() section.
In the code, the counter counts how many times a duplicate has been found. But after that, I can't manage to show only one copy of an item (or uberhaupt something on screen).

I used a second recordset, because I was afraid that rs.movenext would interfere with the display of the file.

If anyone could help me out, that would be great. I'm breaking my neck on this puzzle.

Thanks in advance and cheers,

Devatu

[devatu]

Fixed it with:

Private Sub RefreshListbox()
    Dim rs As Object
    Dim sqlstr As String
    Dim Partname As String
    Dim Recordcount As Long
    Dim Recordvalue As Long
    Dim Data As Variant
    Dim continuevalue As String
    Dim rs_old As String
    Dim rs_new As String
    Dim counter As Integer

    Set rs = CreateObject("ADODB.Recordset")

    sqlstr = "SELECT * FROM [Tabel1]"

    Call connectDatabase

    rs.Open sqlstr, DBCONT

    Recordcount = rs.Recordcount
    Recordvalue = Recordcount - 1
    ListBox1.ColumnCount = 8
    On Error Resume Next
    If Not Recordcount = 0 And rs.EOF = False Then
        ReDim Data(1 To Recordcount - 4, 1 To 7)

        For i = 1 To Recordcount


            rs_old = rs(1)
            Data(i, 2) = rs(1)
            Data(i, 1) = rs(2)
            Data(i, 3) = rs(3)
            Data(i, 4) = rs(4)
            Data(i, 5) = rs(5)
            Data(i, 6) = rs(6)
            Data(i, 7) = rs(7)
            rs.movenext
            rs_new = rs(1)
            While rs_new = rs_old And Not rs.EOF = True
                counter = counter + 1
                rs_old = rs(2)
                rs.movenext
                rs_new = rs(2)

            Wend

        Next i

        Me.ListBox1.List = Data
    End If

    rs.Close
    Call closeDatabase
End Sub

But only with resume on error next, anyone an idea how to solve the errors without it?

[AlphaFrog]

This uses a Scripting Dictionary to test for unique items. Not tested.

Private Sub RefreshListbox()
    Dim rs As Object
    Dim sqlstr As String
    Dim Partname As String
    Dim Recordcount As Long
    Dim Recordvalue As Long
    Dim Data As Variant
    Dim continuevalue As String
    Dim rs_old As String
    Dim rs_new As String
    Dim counter As Integer

    Set rs = CreateObject("ADODB.Recordset")

    sqlstr = "SELECT * FROM [Tabel1]"

    Call connectDatabase

    rs.Open sqlstr, DBCONT

    Recordcount = rs.Recordcount
    Recordvalue = Recordcount - 1
    ListBox1.ColumnCount = 8
    'On Error Resume Next
    If Not Recordcount = 0 And rs.EOF = False Then
        ReDim Data(1 To Recordcount - 4, 1 To 7)

        With CreateObject("Scripting.Dictionary")
            For i = 1 To Recordcount
                If Not .Exists(rs(2)) Then 'Test if unique
                    .Item(rs2) = 1  'add item to dictionary
                    
                    rs_old = rs(1)
                    Data(i, 2) = rs(1)
                    Data(i, 1) = rs(2)
                    Data(i, 3) = rs(3)
                    Data(i, 4) = rs(4)
                    Data(i, 5) = rs(5)
                    Data(i, 6) = rs(6)
                    Data(i, 7) = rs(7)
                  End If

                    rs.movenext
                    rs_new = rs(1)
                    While rs_new = rs_old And Not rs.EOF = True
                        counter = counter + 1
                        rs_old = rs(2)
                        rs.movenext
                        rs_new = rs(2)
        
                    Wend               
    
            Next i
        End With

        Me.ListBox1.List = Data
    End If

    rs.Close
    Call closeDatabase
End Sub

[devatu]

The current code is :

    Dim rs As Object
    Dim sqlstr As String
    Dim Partname As String
    Dim Recordcount As Long
    Dim Recordvalue As Long
    Dim Data As Variant
    Dim continuevalue As String
    Dim rs_old As String
    Dim rs_new As String
    Dim counter As Integer

    Set rs = CreateObject("ADODB.Recordset")

    sqlstr = "SELECT * FROM [Tabel1]"

    Call connectDatabase

    rs.Open sqlstr, DBCONT

    Recordcount = rs.Recordcount
    Recordvalue = Recordcount - 1
    ListBox1.ColumnCount = 8

    While Not rs.EOF = True

        If rs_new = rs_old Then

            rs_old = rs(1)
            rs.movenext
            rs_new = rs(1)

        Else
            If Not Recordcount = 0 And rs.EOF = False Then
                ReDim Data(1 To Recordcount, 1 To 7)

                For i = 1 To Recordcount

                    rs_old = rs(1)
                    Data(i, 2) = rs(1)
                    Data(i, 1) = rs(2)
                    Data(i, 3) = rs(3)
                    Data(i, 4) = rs(4)
                    Data(i, 5) = rs(5)
                    Data(i, 6) = rs(6)
                    Data(i, 7) = rs(7)
                    rs.movenext
                    rs_new = rs(1)
                    While rs_new = rs_old And Not rs.EOF = True
                        counter = counter + 1
                        rs_old = rs(2)
                        rs.movenext
                        rs_new = rs(2)

                    Wend

                Next i

                Me.ListBox1.List = Data
            End If
        End If
    Wend

    rs.Close
    Call closeDatabase

So the While loop should cover an EOF detection. But instead(as you can see on the picture attached) it just gives an error. You can see the While loop above it so I have no idea why it is happening..EOF.png

[devatu]

Thanks for the reply Alphafrog. It doesn't seem to work though and I found that my code still doesn't do the trick aswell, only at friday when I tried it .

The file keeps giving me an EOF error, even if I use a while rs.EOf = False loop. What could be the reason for the EOF not working properly?

[AlphaFrog]

Try this...

Private Sub RefreshListbox()
    
    Dim rs As Object, i As Long
    
    Set rs = CreateObject("ADODB.Recordset")
    sqlstr = "SELECT * FROM [Tabel1]"
    Call connectDatabase
    rs.Open sqlstr, DBCONT
    
    ListBox1.Clear
    ListBox1.ColumnCount = 7
    
    'On Error Resume Next
    
    With CreateObject("Scripting.Dictionary")
        
        Do Until rs.EOF
            
            If Not .Exists(rs(1)) Then    'Test if unique
                
                .Item(rs(1)) = 1  'add item to dictionary
                
                'Add record to Listbox
                With ListBox1
                    .AddItem rs(1)
                    For i = 2 To 7
                        .List(.ListCount - 1, i - 1) = rs(i)
                    Next i
                End With
                
            End If
            
            rs.MoveNext
            
        Loop
        
        rs.Close
        Call closeDatabase
        
    End With
    
End Sub