Format columns in a listbox as Currency

Lars1

Board Regular
Joined
Feb 3, 2021
Messages
97
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
 

Lars1

Board Regular
Joined
Feb 3, 2021
Messages
97
Office Version
  1. 365
Platform
  1. Windows
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
 

Some videos you may like

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

diddi

Well-known Member
Joined
May 20, 2004
Messages
3,261
Office Version
  1. 2010
Platform
  1. Windows
i will take a look tomorrow. approaching midnight here
 

diddi

Well-known Member
Joined
May 20, 2004
Messages
3,261
Office Version
  1. 2010
Platform
  1. Windows
that file is damaged lars
 

Lars1

Board Regular
Joined
Feb 3, 2021
Messages
97
Office Version
  1. 365
Platform
  1. Windows

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
 

diddi

Well-known Member
Joined
May 20, 2004
Messages
3,261
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

i am available for a while now...
this one works
 

diddi

Well-known Member
Joined
May 20, 2004
Messages
3,261
Office Version
  1. 2010
Platform
  1. Windows
adgangskode
?
 

Lars1

Board Regular
Joined
Feb 3, 2021
Messages
97
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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
 

Lars1

Board Regular
Joined
Feb 3, 2021
Messages
97
Office Version
  1. 365
Platform
  1. Windows
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
 

diddi

Well-known Member
Joined
May 20, 2004
Messages
3,261
Office Version
  1. 2010
Platform
  1. Windows
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
 

diddi

Well-known Member
Joined
May 20, 2004
Messages
3,261
Office Version
  1. 2010
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,126,957
Messages
5,621,822
Members
415,859
Latest member
Vain

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
Top