Format columns in a listbox as Currency

[Lars1]

Hi
I am quite new to VBA, and i have a problem with som formats in a listbox.
I would like column 8 and column 10 formatted as currency #.###,## kr the Danish format.

As it is now it comes out with plain numbers like 1000 and the result i am looking for is 1.000,00 kr

There are also two columns formatted as "Short Time", but this is maybe not the best way to format these two columns



Private Sub FillContacts(Optional sFilter As String = "*")
Dim i As Long, j As Long

'Clear any existing entries in the ListBox
Me.ListBox1.Clear

'Loop through all the rows and columns of the contact list
For i = LBound(maContacts, 1) To UBound(maContacts, 1)
For j = 1 To 10
'Compare the contact to the filter
If UCase(maContacts(i, j)) Like UCase("*" & sFilter & "*") Then
'Add it to the ListBox
With Me.ListBox1
.AddItem maContacts(i, 1)
.List(.ListCount - 1, 1) = maContacts(i, 2)
.List(.ListCount - 1, 2) = maContacts(i, 3)
.List(.ListCount - 1, 3) = maContacts(i, 4)
.List(.ListCount - 1, 4) = maContacts(i, 5)
.List(.ListCount - 1, 4) = Format(Time, "Short Time")
.List(.ListCount - 1, 5) = maContacts(i, 6)
.List(.ListCount - 1, 5) = Format(Time, "Short Time")
.List(.ListCount - 1, 6) = maContacts(i, 7)
.List(.ListCount - 1, 7) = maContacts(i, 8)
.List(.ListCount - 1, 8) = maContacts(i, 9)
.List(.ListCount - 1, 9) = maContacts(i, 10)
End With
'If any column matched, skip the rest of the columns
'and move to the next contact
Exit For
End If
Next j
Next i
'Select the first contact
If Me.ListBox1.ListCount > 0 Then Me.ListBox1.ListIndex = 0

 

[diddi]

yes. i did both solutions above. they are in different subs

 

[diddi]

 

[Lars1]

View attachment 31989

Okay. Got it

BUT, when the database is empty,i can't select any employee

 

[diddi]

added an extra If/end if

Private Sub FillContacts(Optional sFilter As String = "*")
    Dim i As Long, j As Long
    
    'Clear any existing entries in the ListBox
    ListBox1.Clear
   
    'Loop through all the rows and columns of the Database
    If Database.ListObjects("Tabel_Database").ListRows.Count > 0 Then
        For i = LBound(maContacts, 1) To UBound(maContacts, 1)
            For j = 1 To 12
                'Compare the contact to the filter
                If UCase(maContacts(i, j)) Like UCase("*" & sFilter & "*") Then
                    'Add it to the ListBox
                    With ListBox1
                        .AddItem maContacts(i, 1)
                        .List(.ListCount - 1, 1) = maContacts(i, 2)
                        .List(.ListCount - 1, 2) = maContacts(i, 3)
                        .List(.ListCount - 1, 3) = Format(maContacts(i, 4), "dd-mm-yyyy")
                        .List(.ListCount - 1, 4) = Format(maContacts(i, 5), "hh:mm")
                        .List(.ListCount - 1, 5) = Format(maContacts(i, 6), "hh:mm")
                        .List(.ListCount - 1, 6) = maContacts(i, 7)
                        .List(.ListCount - 1, 7) = maContacts(i, 8)
                         If maContacts(i, 8) <> "" Then .List(.ListCount - 1, 7) = FormatCurrency(maContacts(i, 8))
                        .List(.ListCount - 1, 8) = maContacts(i, 9)
                        .List(.ListCount - 1, 9) = maContacts(i, 10)
                        If maContacts(i, 10) <> "" Then .List(.ListCount - 1, 9) = FormatCurrency(maContacts(i, 10))
                    End With
                    'If any column matched, skip the rest of the columns
                    'and move to the next contact
                    Exit For
                End If
            Next j
        Next i
    End If
    'Select the first contact
    If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End Sub

 

[diddi]

moved end if

Sub Setup()
    Dim cMedarbejder As Range
    Dim cLoc As Range
    Set ws = Worksheets("Medarbejdere")
    
    If Database.ListObjects("Tabel_Database").ListRows.Count > 0 Then
        maContacts = Database.ListObjects("Tabel_Database").DataBodyRange.Value
    End If
        '    FillContacts
        
    For Each cMedarbejder In ws.Range("medarbejderIDList")
        With cboID
            .AddItem cMedarbejder.Value
            .List(.ListCount - 1, 1) = cMedarbejder.Offset(0, 1).Value
        End With
    Next cMedarbejder
    
    txtDate.Value = Format(Date, "short Date")
    txtStart.Value = Format(Time, "Short Time")
    Me.txtStop.Value = Format(Time + 2 / 24, "Short Time")
    txtQty.Value = 1
    cboID.SetFocus
End Sub

 

[diddi]

basically i am skipping code when the database listcount is 0 (empty)

 

[Lars1]

basically i am skipping code when the database listcount is 0 (empty)

The issues we are working on here is solved, BUT

It seems that other issues is popping up.
I tried add data to emplyee #10, and it does not whow up in the listbox.
When i close the listbox and open up again it shows up.

And other Employees show up in the listbox which should not be there.

Have made so many changes that the basic code is not good enough ?

 

[Lars1]

Hi Diddi
Everything is working fine now. I managed to solve the last issue.
Don´t know what i have done, but it works
Only one small thing left.
Employee 1 is not automaticaly updated in the listbox when entering data, but i can live with this small error and probably solve it in the future.

THANK YOU so much for your help

 

[diddi]

its been a pleasure to assist you Lars. link your final workbook and i will have a quick look at that update issue. i have a suspicion i know what it will be.
Cheers from australia

 

[Lars1]

its been a pleasure to assist you Lars. link your final workbook and i will have a quick look at that update issue. i have a suspicion i know what it will be.
Cheers from australia

Be very carefull Diddi...
We have a saying here in Denmark
"if you give a man your littelfinger he will take the whole arm"

Here is the file i am working on:

Transfer - Dropbox

Dropbox is a free service that lets you bring your photos, docs, and videos anywhere and share them easily. Never email yourself a file again!

www.dropbox.com

Yesterday i got a new wish/request from my employees.
It would be nice if they can edit in the data they already have saved.
IF (and only IF), you feel for it...
I would appreciate your input