Format columns in a listbox as Currency

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
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
there is a vba function FormatCurrency( ) that should do the trick
 
Upvote 0
there is a vba function FormatCurrency( ) that should do the trick
Thank you for your prompt answer...
i am new to VBA, so i am sorry to ask about a specific string or a specific place to use it in my code above.
Is it possible for you to help. Thanks.
 
Upvote 0
VBA Code:
.List(.ListCount - 1, 7) = FormatCurrency(maContacts(i, 8))

.List(.ListCount - 1, 9) = FormatCurrency(maContacts(i, 10))

it has optional extra add ons you can use
FormatCurrency( my number , the number of digits after decimal , True = use leading 0 , True = use ( ) for negative numbers , True = use commas to group digits: 1,000,000 etc )
 
Upvote 0
VBA Code:
.List(.ListCount - 1, 7) = FormatCurrency(maContacts(i, 8))

.List(.ListCount - 1, 9) = FormatCurrency(maContacts(i, 10))

it has optional extra add ons you can use
FormatCurrency( my number , the number of digits after decimal , True = use leading 0 , True = use ( ) for negative numbers , True = use commas to group digits: 1,000,000 etc )
Sorry to get back to you once again...
I have just discoveres that teh code:
.List(.ListCount - 1, 4) = Format(Time, "Short Time")
means that the current time is showing in my listbox.

I do not want to see the current time, but the time actually stated in the database in the right format hh:mm

How to format the column to show this ?
THANKS.
 
Upvote 0
can you show me a line from your database so i can see the exact format of your data pls Lars
 
Upvote 0
can you show me a line from your database so i can see the exact format of your data pls Lars
I am gratefull for your help Diddi.
It turns out that i have a few problems with this one.

First of all the time issue.
I would like the time showed in the listbox with this format: hh:mm

The second issue is the date format is changing. The date format entered and showed in the listbox should be: dd-mm-yyyy

And last. I would like the listbox to update automaticaly when new data is entered.
With this code i need to cloase the userform and open up again.

(I don't expect that you solve all of it :) )


Option Explicit

Private maContacts As Variant

Private Sub cmdAdd_Click()
Dim lRow As Long
Dim lPart As Long
Dim ws As Worksheet
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
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

lPart = Me.cboID.ListIndex

'check for a part number
If Trim(Me.cboID.Value) = "" Then
Me.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 = Me.cboID.Value
.Cells(lRow, 2).Value = Me.cboID.List(lPart, 1)
'.Cells(lRow, 3).Value = Me.cboGodkendt.Value
.Cells(lRow, 4).Value = Me.txtDate.Value
.Cells(lRow, 5).Value = Me.txtStart.Value
.Cells(lRow, 6).Value = Me.txtStop.Value
.Cells(lRow, 7).Value = Me.txtQty.Value
.Cells(lRow, 12).Value = Me.txtAccord.Value
.Cells(lRow, 11).Value = Me.txtProduct.Value
End With

'clear the data
'Me.cboID.Value = ""
'Me.cboGodkendt.Value = ""
Me.txtDate.Value = Format(Date, "short Date")
'Me.txtStart.Value = Format(Time, "Short Time")
'Me.txtStop.Value = Format(Time, "Short Time")
Me.txtQty.Value = 1
Me.txtAccord.Value = ""
Me.txtProduct.Value = ""
Me.cboID.SetFocus

End Sub

Private Sub UserForm_Initialize()
Dim cMedarbejder As Range
Dim cLoc As Range
Dim ws As Worksheet
Set ws = Worksheets("Medarbejdere")

maContacts = Database.ListObjects("Tabel_Database").DataBodyRange.Value
' FillContacts

For Each cMedarbejder In ws.Range("medarbejderIDList")
With Me.cboID
.AddItem cMedarbejder.Value
.List(.ListCount - 1, 1) = cMedarbejder.Offset(0, 1).Value
End With
Next cMedarbejder

Me.txtDate.Value = Format(Date, "short Date")
Me.txtStart.Value = Format(Time, "Short Time")
Me.txtStop.Value = Format(Time, "Short Time")
Me.txtQty.Value = 1
Me.cboID.SetFocus

End Sub

Private Sub cboID_Change()
FillContacts Me.cboID.Text
End Sub
Private Sub cmdUpdate_Click()
FillContacts Me.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
Me.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 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, "hh:mm")
.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, 7) = FormatCurrency(maContacts(i, 8))
.List(.ListCount - 1, 8) = maContacts(i, 9)
.List(.ListCount - 1, 9) = maContacts(i, 10)
.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 Me.ListBox1.ListCount > 0 Then Me.ListBox1.ListIndex = 0
End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub
 
Upvote 0
i need to see what the data looks like. as in what is the input data you are working with
 
Upvote 0
i need to see what the data looks like. as in what is the input data you are working with
I have made a file for you :)

 
Upvote 0

Forum statistics

Threads
1,213,506
Messages
6,114,024
Members
448,543
Latest member
MartinLarkin

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