VB6 listview dynamic filling columnheader formating and column sizing

Hi,

I am trying to dynamically fill a listview in visual basic 6, and succeded.
There are 3 possible queries at the moment.
The idea is to set the listview column headers with the ado.rs.name then format the data depending on the column name and set the column widths according to datatypes.

So far the column headers and the values are correct, but i keeps formating the last columns incorrectly.

Here's my code. (The code I am having trouble with is marked by *****)
======================================================================================
Private Sub lvwStockTotals_DblClick()
On Error GoTo errorhandler

Dim str As String
    With lvwStockTotals
        .FullRowSelect = True
        str = .SelectedItem
    End With
   
    Me.lvwDetails.ListItems.Clear
    Me.lvwDetails.ColumnHeaders.Clear
    SQLrsFictStock = ""
   
   'Select the necessary query based on the selection in the first listview.
    If str = "In stock" Then
        Me.lblType = "In Stock"
        SQLrsFictStock = "SELECT C.Name Warehouse, Pcs, Colli, Kgs, Cbm, Plts FROM Stock S, Customers C WHERE S.WareID=C.CustID AND S.ArtID = " & Me.lblArtID
    ElseIf str = "Expected in" Then
        Me.lblType = "Expected In"
        SQLrsFictStock = "SELECT P.Name Pickup, I.PUDate Date, D.Name Delivery, I.DelDate Date, I.InOutID Reference, R.Pcs, R.Colli, R.Kgs, R.Cbm, R.Plts FROM [Rows] R, InOutHeaders I, Customers P, Customers D Where R.HeaderID = i.InOutID AND P.CustID=I.PUID AND D.CustID=I.DelID AND I.DirIN = 1 AND R.Confirmed = 0 AND ArtID = " & Me.lblArtID
    ElseIf str = "Reserved out" Then
        Me.lblType = "Reserved Out"
        SQLrsFictStock = "SELECT P.Name Pickup, I.PUDate Date, D.Name Delivery, I.DelDate Date, I.InOutID Reference, R.Pcs, R.Colli, R.Kgs, R.Cbm, R.Plts FROM [Rows] R, InOutHeaders I, Customers P, Customers D Where R.HeaderID = i.InOutID AND P.CustID=I.PUID AND D.CustID=I.DelID AND I.DirIN = 0 AND R.Confirmed = 0 AND ArtID = " & Me.lblArtID
    Else
        Exit Sub
    End If
   
    If OpenrsFictStock = True Then ' A function to open this specific recordset.
        If rsFictStock.BOF = False Then ' check that
            Dim i As Integer
            Dim j As Integer
            Dim k As Integer
            Dim RSF As Byte
           
            RSF = rsFictStock.Fields.Count - 1
            k = 1
           
            rsFictStock.MoveFirst
            'Headers & alignment
            For i = 0 To RSF
                'dynamically add the column headers
                Me.lvwDetails.ColumnHeaders.Add , , rsFictStock.Fields(i).Name
               
                'Align the columns and set the width based on the datatype
                If IsNumeric(rsFictStock.Fields(i).Value) Then
                    If i = 0 Then 'First column must always be aligned to the left
                        Me.lvwDetails.ColumnHeaders(i + 1).Alignment = lvwColumnLeft
                        Me.lvwDetails.ColumnHeaders(i + 1).Width = 2000
                    Else
                        Me.lvwDetails.ColumnHeaders(i + 1).Alignment = lvwColumnRight
                        Me.lvwDetails.ColumnHeaders(i + 1).Width = 1000
                    End If
                ElseIf IsDate(rsFictStock.Fields(i).Value) Then
                    Me.lvwDetails.ColumnHeaders(i + 1).Alignment = lvwColumnLeft
                    Me.lvwDetails.ColumnHeaders(i + 1).Width = 1000
                Else
                    Me.lvwDetails.ColumnHeaders(i + 1).Alignment = lvwColumnLeft
                    Me.lvwDetails.ColumnHeaders(i + 1).Width = 2000
                End If
            Next i
           
            rsFictStock.MoveFirst
            'Fill the rows
            Dim l As Integer
            l = 1
            Do While rsFictStock.EOF = False
                'Create the itemlists. Always the first of the rs selection list
                Me.lvwDetails.ListItems.Add , , rsFictStock.Fields(0).Value
               
                'Fill the rows of the listview column by column
                For j = 0 To RSF
***** This code doesn't format the columns correctly, though all the data is in the correct place.
'                    If IsDate(rsFictStock.Fields(j).Value) Then
'                        Me.lvwDetails.ListItems(k).SubItems(j) = Format(rsFictStock.Fields(j).Value, "DD-MM-YY")
'                    ElseIf Me.lvwDetails.ColumnHeaders(j) = "Cbm" Then
'                        Me.lvwDetails.ListItems(k).SubItems(j) = Format(rsFictStock.Fields(j).Value, "#.##0")
'                    ElseIf Me.lvwDetails.ColumnHeaders(j) = "Kgs" Then
'                        Me.lvwDetails.ListItems(k).SubItems(j) = Format(rsFictStock.Fields(j).Value, "Fixed")
'                    ElseIf Me.lvwDetails.ColumnHeaders(j) = "Plts" Then
'                        Me.lvwDetails.ListItems(k).SubItems(j) = Format(rsFictStock.Fields(j).Value, "Fixed")
'                    Else
'                        Me.lvwDetails.ListItems(k).SubItems(j) = rsFictStock.Fields(j).Value
'                    End If
                   
****** this code is simimar to the above code except I tried to use another integer variable to do the ******subitems                    
                    If Me.lvwDetails.ColumnHeaders(l) = "Date" Then
                        Me.lvwDetails.ListItems(k).SubItems(l) = Format(rsFictStock.Fields(j).Value, "DD-MM-YY")
                    ElseIf Me.lvwDetails.ColumnHeaders(l) = "Cbm" Then
                        Me.lvwDetails.ListItems(k).SubItems(l) = Format(rsFictStock.Fields(j).Value, "#.##0")
                    ElseIf Me.lvwDetails.ColumnHeaders(l) = "Kgs" Then
                        Me.lvwDetails.ListItems(k).SubItems(l) = Format(rsFictStock.Fields(j).Value, "Fixed")
                    ElseIf Me.lvwDetails.ColumnHeaders(l) = "Plts" Then
                        Me.lvwDetails.ListItems(k).SubItems(l) = Format(Null2Dbl(rsFictStock.Fields(j).Value), "Fixed")
                    Else
                        Me.lvwDetails.ListItems(k).SubItems(l) = rsFictStock.Fields(j).Value
                    End If
                    l = l + 1
                Next j
               
                k = k + 1
                rsFictStock.MoveNext
            Loop
           
            rsFictStock.Close
            Set rsFictStock = Nothing            
            AdoConn.Close 'Opened in the OpenrsFictStock function
            Set AdoConn = Nothing
        End If
       
        With Me.lvwDetails
            .HideColumnHeaders = False
            .View = lvwReport
        End With
    End If
               
Exit Sub
errorhandler:
    errore FrmFictStock, "lvwStockTotals, DblCick"
======================================================================================
Start Free Trial