Format columns in a listbox as Currency

L

Lars1

Board Regular
Joined
Feb 3, 2021
Messages
154
Office Version
  1. 365
Platform
  1. Windows
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
 
Sort by date Sort by votes
ok now i can see what you are doing. it looks pretty good.
this will sort the first issue. i have changed it in my copy. change yours and indicate you are happy and we can move on
VBA Code: 
                    .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")
 
Last edited:
Upvote 0

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
diddi said:
ok now i can see what you are doing. it looks pretty good.
this will sort the first issue. i have changed it in my copy. change yours and indicate you are happy and we can move on
VBA Code: 
                    .List(.ListCount - 1, 4) = Format(maContacts(i, 5), "hh:mm")
                    .List(.ListCount - 1, 5) = Format(maContacts(i, 6), "hh:mm")
Click to expand...
Works perfectly (y)
 
Upvote 0
i have added the second issue in the previous post :)
be back in a while (maybe 2 hours). when you see me back online, if you can stay on i will just work with you to knock over the issues without having to wait for hours
 
Upvote 0
diddi said:
i have added the second issue in the previous post :)
be back in a while (maybe 2 hours). when you see me back online, if you can stay on i will just work with you to knock over the issues without having to wait for hours
Click to expand...
Again, it works perfectly :)
THANKS
 
Upvote 0
ok i am back from dinner with my neighbors
 
Upvote 0
ok lets get these problems fixed. you have the benefit of a half bottle of red wine to help me get those answers flowing !
i have your excel open
 
Upvote 0
diddi said:
ok lets get these problems fixed. you have the benefit of a half bottle of red wine to help me get those answers flowing !
i have your excel open
Click to expand...
:)
Okay. What i am missing in my little project is:
When i fill out the userform.
Selecting an employee and fill out the fields with data and click the "Gem Data" button (Save button)
I would like the listbox to update automaticaly with the new data just entered.

AND, if possible...
sort the listbox Descending from date...
 
Upvote 0
ok i have it now... i will post the whole thin. i have removed the referneces to Me. which are not required and fiddled a bit so best to just replace all your code with mine

VBA Code: 
Option Explicit
Dim ws As Worksheet, SelIdx As Long

Private maContacts As Variant

Private Sub cmdAdd_Click()
    Dim lRow As Long
    Dim lPart As Long
    Set ws = Worksheets("Database")
    
    'find  first empty row in database
    ''lRow = ws.Cells(Rows.Count, 1) _
    ''  .End(xlUp).Offset(1, 0).Row
    
    'revised code to avoid problems with
    'Excel lists and tables in newer versions
    SelIdx = cboID.ListIndex
    lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
    lPart = cboID.ListIndex
    
    'check for a part number
    If Trim(cboID.Value) = "" Then
        cboID.SetFocus
        MsgBox "Venligst vælg medarbejder fra listen"
        Exit Sub
    End If
    
    'copy the data to the database
    With ws
        .Cells(lRow, 1).Value = cboID.Value
        .Cells(lRow, 2).Value = cboID.List(lPart, 1)
        '.Cells(lRow, 3).Value = cboGodkendt.Value
        .Cells(lRow, 4).Value = txtDate.Value
        .Cells(lRow, 5).Value = txtStart.Value
        .Cells(lRow, 6).Value = txtStop.Value
        .Cells(lRow, 7).Value = txtQty.Value
        .Cells(lRow, 12).Value = txtAccord.Value
        .Cells(lRow, 11).Value = txtProduct.Value
    End With
    
    'clear the data
    'cboID.Value = ""
    'cboGodkendt.Value = ""
    txtDate.Value = Format(Date, "short Date")
    'txtStart.Value = Format(Time, "Short Time")
    'txtStop.Value = Format(Time, "Short Time")
    txtQty.Value = 1
    txtAccord.Value = ""
    txtProduct.Value = ""
    cboID.SetFocus
    
    Setup
    cboID.ListIndex = 0
    cboID.ListIndex = SelIdx

End Sub

Private Sub UserForm_Initialize()
    Setup
End Sub

Sub Setup()
    Dim cMedarbejder As Range
    Dim cLoc As Range
    Set ws = Worksheets("Medarbejdere")

    maContacts = Database.ListObjects("Tabel_Database").DataBodyRange.Value
    '    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")
    txtStop.Value = Format(Time, "Short Time")
    txtQty.Value = 1
    cboID.SetFocus
End Sub

Private Sub cboID_Change()
    FillContacts cboID.Text
End Sub

Private Sub cmdUpdate_Click()
    FillContacts cboID.Text
End Sub

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
    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
    'Select the first contact
    If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub
 
Upvote 0
diddi said:
ok i have it now... i will post the whole thin. i have removed the referneces to Me. which are not required and fiddled a bit so best to just replace all your code with mine

VBA Code: 
Option Explicit
Dim ws As Worksheet, SelIdx As Long

Private maContacts As Variant

Private Sub cmdAdd_Click()
    Dim lRow As Long
    Dim lPart As Long
    Set ws = Worksheets("Database")
   
    'find  first empty row in database
    ''lRow = ws.Cells(Rows.Count, 1) _
    ''  .End(xlUp).Offset(1, 0).Row
   
    'revised code to avoid problems with
    'Excel lists and tables in newer versions
    SelIdx = cboID.ListIndex
    lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
    lPart = cboID.ListIndex
   
    'check for a part number
    If Trim(cboID.Value) = "" Then
        cboID.SetFocus
        MsgBox "Venligst vælg medarbejder fra listen"
        Exit Sub
    End If
   
    'copy the data to the database
    With ws
        .Cells(lRow, 1).Value = cboID.Value
        .Cells(lRow, 2).Value = cboID.List(lPart, 1)
        '.Cells(lRow, 3).Value = cboGodkendt.Value
        .Cells(lRow, 4).Value = txtDate.Value
        .Cells(lRow, 5).Value = txtStart.Value
        .Cells(lRow, 6).Value = txtStop.Value
        .Cells(lRow, 7).Value = txtQty.Value
        .Cells(lRow, 12).Value = txtAccord.Value
        .Cells(lRow, 11).Value = txtProduct.Value
    End With
   
    'clear the data
    'cboID.Value = ""
    'cboGodkendt.Value = ""
    txtDate.Value = Format(Date, "short Date")
    'txtStart.Value = Format(Time, "Short Time")
    'txtStop.Value = Format(Time, "Short Time")
    txtQty.Value = 1
    txtAccord.Value = ""
    txtProduct.Value = ""
    cboID.SetFocus
   
    Setup
    cboID.ListIndex = 0
    cboID.ListIndex = SelIdx

End Sub

Private Sub UserForm_Initialize()
    Setup
End Sub

Sub Setup()
    Dim cMedarbejder As Range
    Dim cLoc As Range
    Set ws = Worksheets("Medarbejdere")

    maContacts = Database.ListObjects("Tabel_Database").DataBodyRange.Value
    '    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")
    txtStop.Value = Format(Time, "Short Time")
    txtQty.Value = 1
    cboID.SetFocus
End Sub

Private Sub cboID_Change()
    FillContacts cboID.Text
End Sub

Private Sub cmdUpdate_Click()
    FillContacts cboID.Text
End Sub

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
    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
    'Select the first contact
    If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub
Click to expand...
Amazing work (y)
THANK YOU so much for your effort.
i Will celebrate with a nice bottle of wine from "Poppelvej Winery" :)
THANKS!!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Display textbox from listbox - getting 381 error
Replies
4
Views
217
maiatanaka
M
P
  • Question
ListBox Click to textbox & delete row
Replies
0
Views
327
pure vito
P
I
  • Question
Listbox multiple column advice
2
Replies
10
Views
318
ipbr21054
I
I
  • Question
Listbox not being populate when code is run
Replies
4
Views
288
ipbr21054
I
A
  • Solved
Listbox For Loop
Replies
7
Views
375
6StringJazzer
6StringJazzer

Forum statistics

Threads
1,214,983
Messages
6,122,582
Members
449,089
Latest member
Motoracer88

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top