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
 
send me the most up to date copy. i will insert a transparent backup. glad it has turned out to be a useful project for you

Hi Diddi

I actually found out how to make a backup.
But then i found out that i need a kind of "settings" section where i can define the path and filename
O my problem now is.
How to get the text (path and filename) from the textbox "txtPath" ind to my code ?

VBA Code:
Sub CopyWorkbook() 'kopierer kun en del af arket "database" til fil på F drevet og gemmer uden kæder

'Copy range to clipboard
    Workbooks("LP_TEST_Akkord.xlsm").Worksheets("Database").Range("A:R").Copy

'Open workbook og indsæt værdier uden kæder
    Workbooks.Open("F:\Accord\LP_TEST\AkkordData.xlsx").Worksheets("Database").Range("A:R").PasteSpecial Paste:=xlPasteValues
    Workbooks("AkkordData.xlsx").Close SaveChanges:=True
End Sub
Udklip1.JPG
 
Upvote 0

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
i will take a look tomorrow. approaching midnight here
 
Upvote 0

Hi Diddi

I actually found out how to make a backup.
But then i found out that i need a kind of "settings" section where i can define the path and filename
O my problem now is.
How to get the text (path and filename) from the textbox "txtPath" ind to my code ?

VBA Code:
Sub CopyWorkbook() 'kopierer kun en del af arket "database" til fil på F drevet og gemmer uden kæder

'Copy range to clipboard
    Workbooks("LP_TEST_Akkord.xlsm").Worksheets("Database").Range("A:R").Copy

'Open workbook og indsæt værdier uden kæder
    Workbooks.Open("F:\Accord\LP_TEST\AkkordData.xlsx").Worksheets("Database").Range("A:R").PasteSpecial Paste:=xlPasteValues
    Workbooks("AkkordData.xlsx").Close SaveChanges:=True
End Sub

that file is damaged lars
 
Upvote 0
i am available for a while now...
this one works
 
Upvote 0
Okay :)

I actually found out how to make a backup.
But then i found out that i need a kind of "settings" section where i can define the path and filename
So my problem now is:
How to get the text (path and filename) from the textbox "txtPath" in to my code ?

VBA Code:
Sub CopyWorkbook() 'kopierer kun en del af arket "database" til fil på F drevet og gemmer uden kæder

'Copy range to clipboard
    Workbooks("LP_TEST_Akkord.xlsm").Worksheets("Database").Range("A:R").Copy

'Open workbook og indsæt værdier uden kæder
    Workbooks.Open("F:\Accord\LP_TEST\AkkordData.xlsx").Worksheets("Database").Range("A:R").PasteSpecial Paste:=xlPasteValues
    Workbooks("AkkordData.xlsx").Close SaveChanges:=True
End Sub
 
Upvote 0
Okay :)

I actually found out how to make a backup.
But then i found out that i need a kind of "settings" section where i can define the path and filename
So my problem now is:
How to get the text (path and filename) from the textbox "txtPath" in to my code ?

VBA Code:
Sub CopyWorkbook() 'kopierer kun en del af arket "database" til fil på F drevet og gemmer uden kæder

'Copy range to clipboard
    Workbooks("LP_TEST_Akkord.xlsm").Worksheets("Database").Range("A:R").Copy

'Open workbook og indsæt værdier uden kæder
    Workbooks.Open("F:\Accord\LP_TEST\AkkordData.xlsx").Worksheets("Database").Range("A:R").PasteSpecial Paste:=xlPasteValues
    Workbooks("AkkordData.xlsx").Close SaveChanges:=True
End Sub
Adgangskode = Password
Password = godkend
 
Upvote 0
see if this solves the issue
VBA Code:
Sub CopyWorkbook() 'kopierer kun en del af arket "database" til fil på F drevet og gemmer uden kæder

'Copy range to clipboard
    Workbooks("LP_Akkord_MrExcel.xlsm").Worksheets("Database").Range("A:R").Copy

'Open workbook og indsæt værdier uden kæder
    Workbooks.Open(Trim(TextBox2.Value)).Worksheets("Database").Range("A:R").PasteSpecial Paste:=xlPasteValues
    Workbooks("AkkordData.xlsx").Close SaveChanges:=True
End Sub
 
Upvote 0
oh i broke in

just an observation with your backup. you only have one backup because the next one overwrites the previous. so if someone messes it all up, and then does a backup you loose your data
not the best plan imo
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,981
Members
448,538
Latest member
alex78

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