Using VBA to get data from a random .csv and then create, replace and rename the new sheet

Want2BExcel

Board Regular
Joined
Nov 24, 2021
Messages
114
Office Version
  1. 2016
Platform
  1. Windows
I recorded this macro to get data from a csv file and I want to make it more user-friendly. So I'm looking for some assistance to a few things.

In this example I'm choosing a specific file D:\Økonomi\Budget\Budget_JAN_22.csv but I want fileexplore to open and let the user point to the location of the wanted csv file. Futhermore I can see in the code that the name of the csv file in my example Budget_JAN_22 is used multible times. These sections need to be depending of the chosen file, so if the file is called Budget_MAY_23.csv then that's the name used throughout the procedure.

In the end of the recorded code, I have another issue, well I have two.
1. Renaming and moving the sheet. I see a problem since the sheet number varies from user to user (here it's sheet5 [Ark5]), so how do I solve both moving and renaming a sheet that can have various numbers?
Renaming is important because another macro should be able to find it later on. I piture this solution to be a pop-up window where the user input the sheet name, maybe with some restrictions to three letter month name, a space, an ', and to number year. In my example: Jan '22 (if possible). If this is to much trouble, then nevermind. I'll just explain the importence of this somehow. But if it's possible it would be mindblowing fantastic!!!!
2. To make the whole workbook look nice, I move the sheet Jan '22 to the right place (in the code it's before sheet 91) after Dec '21 The new sheets will always be placed month/year after another. So next will be Feb '22, Mar '22 etc. Can this also be automated?

YES I have a lot of sheets ? but I've been building/using this workbook since 2015. Now I just want to share it to all that wants it and for that I need to make something more efficient and user-friendly, because there is alot going on....and very few people love playing with Excel as much as I do ?

VBA Code:
Sub HentDATAfraCSV2()
'
' HentDATAfraCSV2 Makro
'

'
    ActiveWorkbook.Queries.Add Name:="Budget_JAN_22", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Kilde = Csv.Document(File.Contents(""D:\Økonomi\Budget\Budget_JAN_22.csv""),[Delimiter="";"", Columns=4, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Hævede overskrifter"" = Table.PromoteHeaders(Kilde, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Ændret type"" = Table.TransformColumnTypes(#""Hævede overskrifter"",{{""Dato"", type date}, {""Tekst"", type text}" & _
        ", {""Beløb"", type number}, {""Saldo"", type number}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Ændret type"""
    Sheets.Add After:=ActiveSheet
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Budget_JAN_22;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Budget_JAN_22]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = False
        .ListObject.DisplayName = "Budget_JAN_22"
        .Refresh BackgroundQuery:=False
    End With
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Sheets("Ark5").Select
    Sheets("Ark5").Name = "Jan '22"
    Sheets("Ark5").Select
    Sheets("Ark5").Move Before:=Sheets(91)
End Sub
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
i've been using this for a while which sounds similar to what you need. it was something i cannibalised from somewhere else for my own purposes a long time ago and i've sorta forgotten how it works. i tried to change it a bit to suit your needs. hopefully it still functions.

VBA Code:
Sub mrexcelhelp1()
Sheets.Add After:=Worksheets(Worksheets.Count)

ChDir ThisWorkbook.Path

fname = Application.GetOpenFilename("CSV Files (*.csv), *.csv")
If fname = "False" Then Exit Sub

lastrow = Range("A" & Rows.Count).End(xlUp).Row

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fname, _
        Destination:=Range("A" & lastrow))
            .Name = "sample"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierNone
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = "" & Chr(10) & ""
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, _
               1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
               1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
               1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
    End With

NewName = InputBox("What Do you Want to Name the New Sheet?")

ActiveSheet.Name = NewName


ActiveSheet.QueryTables(1).Delete
End Sub

Sheets.Add After:=Worksheets(Worksheets.Count) will add the new sheet to the end of the workbook. i dont know how close Dec '21 is to the end but if there's always a fixed number of other sheets before the end of the workbook you can try
Sheets.Add After:=Worksheets(Worksheets.Count-10) or something
 
Upvote 0
i've been using this for a while which sounds similar to what you need. it was something i cannibalised from somewhere else for my own purposes a long time ago and i've sorta forgotten how it works. i tried to change it a bit to suit your needs. hopefully it still functions.

VBA Code:
Sub mrexcelhelp1()
Sheets.Add After:=Worksheets(Worksheets.Count)

ChDir ThisWorkbook.Path

fname = Application.GetOpenFilename("CSV Files (*.csv), *.csv")
If fname = "False" Then Exit Sub

lastrow = Range("A" & Rows.Count).End(xlUp).Row

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fname, _
        Destination:=Range("A" & lastrow))
            .Name = "sample"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierNone
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = "" & Chr(10) & ""
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, _
               1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
               1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
               1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
    End With

NewName = InputBox("What Do you Want to Name the New Sheet?")

ActiveSheet.Name = NewName


ActiveSheet.QueryTables(1).Delete
End Sub

Sheets.Add After:=Worksheets(Worksheets.Count) will add the new sheet to the end of the workbook. i dont know how close Dec '21 is to the end but if there's always a fixed number of other sheets before the end of the workbook you can try
Sheets.Add After:=Worksheets(Worksheets.Count-10) or something
I just tried it. Somethings works, but alot don't. I get the option with fileExplore to point to a csv file and in the end I get to name the sheet. Two very important things!!! BUT...it mixes up the data from the csv file. Some data is in the right cells and some cells have combined data (see pictures), so it wouldn't work. But I will try and see (if I can translate this....still a noob) what I can and can't use. Thank you so far ;)
 
Last edited:
Upvote 0
I just tried it. Somethings works, but alot don't. I get the option with fileExplore to point to a csv file and in the end I get to name the sheet. Two very important things!!! BUT...it mixes up the data from the csv file. Some data is in the right cells and some cells have combined data (see pictures), so it wouldn't work. But I will try and see (if I can translate this....still a noob) what I can and can't use. Thank you so far ;)
1Udklip.JPG
2Udklip.JPG
 
Upvote 0
maybe change
VBA Code:
.TextFileSemicolonDelimiter = False
to
VBA Code:
.TextFileSemicolonDelimiter = True

sorry i'm not great at this. hopefully someone can give a better solution
 
Upvote 0
maybe change
VBA Code:
.TextFileSemicolonDelimiter = False
to
VBA Code:
.TextFileSemicolonDelimiter = True

sorry i'm not great at this. hopefully someone can give a better solution
Well, you wasn't wrong ;) It was a step in the right direction. I manged to take a step more and correcting column A + B to tekst when changing this:
VBA Code:
.TextFileColumnDataTypes = Array(2, 2, 1, 1)
 
Upvote 0
BUT, I'm still far from the goal. I still have problems :unsure:
#1 The new sheet doesn't include the data being put in a dynamic table

#2 The Spelling doesn't translate correctly. Since I'm danish, there is a few more letters in our alphabet: Æ, Ø, and Å, so the danish word for amount is "beløb" and it tranlates to Bel°b. To resolve this I have been looking on some of the data from my recorded macro, where I can see that something is happening, that not only names the headers correctly, but also allows æ, ø, and å in the text anywhere it's occurs. But no matter how I try to write this in fhqwgads contribution to solve this problem, I get an error. I'm talking about this:
VBA Code:
ActiveWorkbook.Queries.Add Name:="Budget_JAN_22", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Kilde = Csv.Document(File.Contents(""D:\Økonomi\Budget\Budget_JAN_22.csv""),[Delimiter="";"", Columns=4, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Hævede overskrifter"" = Table.PromoteHeaders(Kilde, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Ændret type"" = Table.TransformColumnTypes(#""Hævede overskrifter"",{{""Dato"", type date}, {""Tekst"", type text}" & _
        ", {""Beløb"", type number}, {""Saldo"", type number}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Ændret type"""

#3 Rename the tablename (DesignTab). BSALV helped me with something like this, in one of my other posts: VBA: Change a random tablename and useraction to a formula look for MAIN Problem#1, In this case, the first part of the TableName is fixed to BUDGET_ and the last part, should be the new sheets name JAN_22, but again, no matter how I try to write the part of BSALV's solution (atlest the part I think does this) in fhqwgads contribution, to solve this problem, I again get an error ? Maybe it because I haven't figured out how to make it a table yet (#1). I'm not yet good enough to read VBA code proberly, changing it to my needs ?

#4 Moving the new sheet to the end (guess evey nem sheet should go there, because it is obvious that they would be created one month after another e.g. Budget_JAN_22, Budget_FEB_22 etc.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,835
Messages
6,181,247
Members
453,026
Latest member
cknader

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