• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

vba to convert a csv file to xlsx but some modification required

R

RAM72

Member
Hi ALL:confused:
I have a bunch of csv file from an external interface.
The csv format is always same only data differ.
Tried to achieve through recorded macro but unsuccessful.
It converts three lines and stops.
The headers always start at row 14 and part are found also in row 15 see csv attached file

See expected results trying to achieve and save in excel format.

The first step is to cut all data headers in row 15 and paste to it to the above cell headers.

Go to special select blanks cells in J14 (always )Extended Fob price header

Select blanks delete sheet rows still to last data row.

Select DATA in cell D10 (ALWAYS ) then copy to cell A15 Inv No Headers still to last data row of header stock no.

Then delete all rows from A1 to A13 inclusive data so that row 14 starts at row 1 and save as the sheet tab no 60033.xlsx in a named csvfile convert directory which is on my desktop.

However, All csv file interface are found in this directory and all xlsx will be save in same directory of csv.

Actually doing this manually, very painful:mad::(.

C'ant load csv file

https://www.dropbox.com/s/5a3b8pkvtc9zjfl/60033.csv?dl=0
The xlsx file is the expected results
I d'ont if this is achievable in vba.
Thanks if anyone can help
 

Attachments

  • csv.jpg
    csv.jpg
    124.8 KB · Views: 11
  • 60033.xlsx
    25.6 KB · Views: 2
RAM72 said:
Tried to achieve through recorded macro but unsuccessful.
It converts three lines and stops.
Click to expand...
As Macro Recorder saved what you have done …
Posting code between code tags should help
to underdand your issue and your need from below …

RAM72 said:
The headers always start at row 14
Click to expand...
Nope ‼ From your 60033.csv file, headers start from row #12 …

RAM72 said:
Go to special select blanks cells in J14 (always )Extended Fob price header
Click to expand...
In J14 value is 108 …

RAM72 said:
Select DATA in cell D10
Click to expand...
D10 is blank …

RAM72 said:
I d'ont if this is achievable in vba.
Click to expand...
Should be even with starting from Macro Recorder …
​
 
Next code works only if its workbook is saved in csv directory :
Code: 
Sub Macro1()
      Application.DisplayAlerts = False
      Application.ScreenUpdating = False
      CSV$ = Dir(ThisWorkbook.Path & "\*.csv")
While CSV > ""
    N& = N& + 1
    Workbooks.OpenText ThisWorkbook.Path & "\" & CSV, xlWindows, , xlDelimited, xlTextQualifierNone, Comma:=True, DecimalSeparator:="."
  With ActiveSheet.UsedRange.Columns
         .Range("D1:D11").Clear
    With .Resize(, .Count + 1)
         .Item(.Count).Formula = "=D1="""""
         .Sort .Cells(.Count), xlAscending, Header:=xlNo
          Union(.Item(.Count), .Rows(Application.Match(True, .Item(.Count), 0) & ":" & .Rows.Count)).Clear
    End With
         .Range("A2", .Cells(1).End(xlDown)).Value = .Parent.Name
         .AutoFit
  End With
    ActiveWorkbook.SaveAs Replace(ActiveWorkbook.FullName, ".csv", ".xlsx"), 51
    ActiveWorkbook.Close
      CSV = Dir
Wend
      Application.DisplayAlerts = True
      Application.ScreenUpdating = True
      MsgBox N & " csv file" & IIf(N > 1, "s", "") & " converted", vbInformation, "      Done !"
End Sub
Do you like it ? So thanks to click on bottom right Like !
​
 
RAM72,

See if this is how you wanted.
Code: 
Sub test()
    Dim fn As String, txt As String, myInv As String
    fn = Application.GetOpenFilename("CSVFiles,*.csv")
    If fn = "False" Then Exit Sub
    txt = Space(FileLen(fn))
    Open fn For Binary As #1
        Get #1, , txt
    Close #1
    With CreateObject("VBScript.RegExp")
        .Global = True: .MultiLine = True
        .Pattern = "Inv. No\.,(\d+)"
        myInv = .Execute(txt)(0).submatches(0)
        .Pattern = "^Inv\. No\."
        txt = Mid$(txt, .Execute(txt)(0).firstindex + 1)
        .Pattern = "^,{4,}.*,+\r\n"
        txt = .Replace(txt, "")
        .Pattern = "^\d+"
        txt = .Replace(txt, myInv)
    End With
    fn = Replace(fn, ".csv", "Cleaned_.csv")
    Open fn For Output As #1
        Print #1, txt
    Close #1
    TextImport fn, myInv
    On Error Resume Next
    Kill fn
    On Error GoTo 0
End Sub

Private Sub TextImport(fn As String, myInv As String)
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & fn, Destination:=Range("$A$1"))
        .Parent.Name = myInv
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .Refresh BackgroundQuery:=False
        .Delete
    End With
End Sub
 
Marc L said:
As Macro Recorder saved what you have done …
Posting code between code tags should help
to underdand your issue and your need from below …


Nope ‼ From your 60033.csv file, headers start from row #12 …


In J14 value is 108 …


D10 is blank …


Should be even with starting from Macro Recorder …
​
Click to expand...

Hi Marc

See below code of macro recorder

Code: 
Sub TESTCSV1()  
'  
' TESTCSV1 Macro  
'  
  
'  
    Range("H13").Select  
    ActiveCell.FormulaR1C1 = ""  
    Range("H12").Select  
    ActiveCell.FormulaR1C1 = "Pack Qty/Weight"  
    Range("I13").Select  
    ActiveCell.FormulaR1C1 = ""  
    Range("I12").Select  
    ActiveCell.FormulaR1C1 = "Unit FOB Price"  
    Range("J13").Select  
    ActiveCell.FormulaR1C1 = ""  
    Range("J12").Select  
    ActiveCell.FormulaR1C1 = " Extended FOB Price"  
    Range("K13").Select  
    ActiveCell.FormulaR1C1 = ""  
    Range("K12").Select  
    ActiveCell.FormulaR1C1 = " Subtotal per HS Code"  
    Range("J12").Select  
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlDown)).Select
    Range(Selection    Selection.End(xlUp)).Select
    Selection.SpecialCells(xlCellTypeBlanks).Select  
    Selection.EntireRow.Delete  
    Range("D8").Select  
    Selection.Copy  
    Range("A13").Select  
    Range(Selection    Selection.End(xlDown)).Select
    ActiveSheet.Paste  
    Rows("1:11").Select  
    Range("A11").Activate  
    Application.CutCopyMode = False  
    Selection.Delete Shift:=xlUp  
    ActiveWindow.SmallScroll Down:=-12  
End Sub
 
Marc L said:
Next code works only if its workbook is saved in csv directory :
Code: 
Sub Macro1()
      Application.DisplayAlerts = False
      Application.ScreenUpdating = False
      CSV$ = Dir(ThisWorkbook.Path & "\*.csv")
While CSV > ""
    N& = N& + 1
    Workbooks.OpenText ThisWorkbook.Path & "\" & CSV, xlWindows, , xlDelimited, xlTextQualifierNone, Comma:=True, DecimalSeparator:="."
  With ActiveSheet.UsedRange.Columns
         .Range("D1:D11").Clear
    With .Resize(, .Count + 1)
         .Item(.Count).Formula = "=D1="""""
         .Sort .Cells(.Count), xlAscending, Header:=xlNo
          Union(.Item(.Count), .Rows(Application.Match(True, .Item(.Count), 0) & ":" & .Rows.Count)).Clear
    End With
         .Range("A2", .Cells(1).End(xlDown)).Value = .Parent.Name
         .AutoFit
  End With
    ActiveWorkbook.SaveAs Replace(ActiveWorkbook.FullName, ".csv", ".xlsx"), 51
    ActiveWorkbook.Close
      CSV = Dir
Wend
      Application.DisplayAlerts = True
      Application.ScreenUpdating = True
      MsgBox N & " csv file" & IIf(N > 1, "s", "") & " converted", vbInformation, "      Done !"
End Sub
Do you like it ? So thanks to click on bottom right Like !
​
Click to expand...

Hi Marc

Tried the code, it gives impression it is working as the screen flickers but I do not see any output results or message.

I tried to create a folder on C:\\ csv on drive, put the csv file but still no output or message:(.
Csv folder on desktop still same issue:(

Kindly advise or I have a wrong manipulation
 
My revisited Macro recorder code works like a breeze on my side
without any flickering !

Just follow the unique direction in my previous post before the code :
Marc L said:
Next code works only if its workbook is saved in csv directory
Click to expand...
And first try with only same csv text file joined in dropbox
as my code is based upon it.

If not works from your side,
progress in code in step by step mode via F8 key to check out …
​
 
Marc L said:
My revisited Macro recorder code works like a breeze on my side
without any flickering !

Just follow the unique direction in my previous post before the code :

And first try with only same csv text file joined in dropbox
as my code is based upon it.

If not works from your side,
progress in code in step by step mode via F8 key to check out …
​
Click to expand...
continue screen shotsmarc_6.jpg MARC 7 DETAIL.jpg MARC 7A DETAIL.jpg
 
jindon said:
RAM72,

See if this is how you wanted.
Code: 
Sub test()
    Dim fn As String, txt As String, myInv As String
    fn = Application.GetOpenFilename("CSVFiles,*.csv")
    If fn = "False" Then Exit Sub
    txt = Space(FileLen(fn))
    Open fn For Binary As #1
        Get #1, , txt
    Close #1
    With CreateObject("VBScript.RegExp")
        .Global = True: .MultiLine = True
        .Pattern = "Inv. No\.,(\d+)"
        myInv = .Execute(txt)(0).submatches(0)
        .Pattern = "^Inv\. No\."
        txt = Mid$(txt, .Execute(txt)(0).firstindex + 1)
        .Pattern = "^,{4,}.*,+\r\n"
        txt = .Replace(txt, "")
        .Pattern = "^\d+"
        txt = .Replace(txt, myInv)
    End With
    fn = Replace(fn, ".csv", "Cleaned_.csv")
    Open fn For Output As #1
        Print #1, txt
    Close #1
    TextImport fn, myInv
    On Error Resume Next
    Kill fn
    On Error GoTo 0
End Sub

Private Sub TextImport(fn As String, myInv As String)
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & fn, Destination:=Range("$A$1"))
        .Parent.Name = myInv
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .Refresh BackgroundQuery:=False
        .Delete
    End With
End Sub
Click to expand...

Will advise you Jindon
 
Marc L said:
Next code works only if its workbook is saved in csv directory :
Code: 
Sub Macro1()
      Application.DisplayAlerts = False
      Application.ScreenUpdating = False
      CSV$ = Dir(ThisWorkbook.Path & "\*.csv")
While CSV > ""
    N& = N& + 1
    Workbooks.OpenText ThisWorkbook.Path & "\" & CSV, xlWindows, , xlDelimited, xlTextQualifierNone, Comma:=True, DecimalSeparator:="."
  With ActiveSheet.UsedRange.Columns
         .Range("D1:D11").Clear
    With .Resize(, .Count + 1)
         .Item(.Count).Formula = "=D1="""""
         .Sort .Cells(.Count), xlAscending, Header:=xlNo
          Union(.Item(.Count), .Rows(Application.Match(True, .Item(.Count), 0) & ":" & .Rows.Count)).Clear
    End With
         .Range("A2", .Cells(1).End(xlDown)).Value = .Parent.Name
         .AutoFit
  End With
    ActiveWorkbook.SaveAs Replace(ActiveWorkbook.FullName, ".csv", ".xlsx"), 51
    ActiveWorkbook.Close
      CSV = Dir
Wend
      Application.DisplayAlerts = True
      Application.ScreenUpdating = True
      MsgBox N & " csv file" & IIf(N > 1, "s", "") & " converted", vbInformation, "      Done !"
End Sub
Do you like it ? So thanks to click on bottom right Like !
​
Click to expand...

HI mr. Jindon
Fantastic
 
Thanks mohadin but I'm not jindon !
So I guess it works on your side too … Your Excel version is ?

RAM72, I'm still waiting your test with the same csv text file
as the one joined in dropbox, 60033 and not 107804 !
Code must be in a .xlsm or .xlsb workbook saved in csv directory
(or even a .xls, depends on your Excel version) …
​
 
Marc L said:
Thanks mohadin but I'm not jindon !
So I guess it works on your side too … Your Excel version is ?

RAM72, I'm still waiting your test with the same csv text file
as the one joined in dropbox, 60033 and not 107804 !
Code must be in a .xlsm or .xlsb workbook saved in csv directory
(or even a .xls, depends on your Excel version) …
​
Click to expand...
I am using excel 2016 home, what happens that i opened vb editor paste your code and opened csv , run your code , then i d ont know where excel opened a new file with sheet tab 107804 am still figuring out the why of th however i will make a try
Per your recommendation Code must be in a .xlsm or .xlsb workbook saved in csv directory
(or even a .xls, depends on your Excel version) … and informed you accordingly,

Will have to make test excel 2007 at work.

That of jindon is working on 2016 but so far not tested on 2007.
 
jindon said:
RAM72,

See if this is how you wanted.
Code: 
Sub test()
    Dim fn As String, txt As String, myInv As String
    fn = Application.GetOpenFilename("CSVFiles,*.csv")
    If fn = "False" Then Exit Sub
    txt = Space(FileLen(fn))
    Open fn For Binary As #1
        Get #1, , txt
    Close #1
    With CreateObject("VBScript.RegExp")
        .Global = True: .MultiLine = True
        .Pattern = "Inv. No\.,(\d+)"
        myInv = .Execute(txt)(0).submatches(0)
        .Pattern = "^Inv\. No\."
        txt = Mid$(txt, .Execute(txt)(0).firstindex + 1)
        .Pattern = "^,{4,}.*,+\r\n"
        txt = .Replace(txt, "")
        .Pattern = "^\d+"
        txt = .Replace(txt, myInv)
    End With
    fn = Replace(fn, ".csv", "Cleaned_.csv")
    Open fn For Output As #1
        Print #1, txt
    Close #1
    TextImport fn, myInv
    On Error Resume Next
    Kill fn
    On Error GoTo 0
End Sub

Private Sub TextImport(fn As String, myInv As String)
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & fn, Destination:=Range("$A$1"))
        .Parent.Name = myInv
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .Refresh BackgroundQuery:=False
        .Delete
    End With
End Sub
Click to expand...

Hi Jindon

Tested your code working as requested on 2016 excel will have to try excel 2007 at work and informed you
 
Marc L said:
Thanks mohadin but I'm not jindon !
So I guess it works on your side too … Your Excel version is ?

RAM72, I'm still waiting your test with the same csv text file
as the one joined in dropbox, 60033 and not 107804 !
Code must be in a .xlsm or .xlsb workbook saved in csv directory
(or even a .xls, depends on your Excel version) …
​
Click to expand...

ok Marc I have created CSV directory on:awesome:\\CSV
Insert the file 60033 as 1test as xls, 2 test as xlsx ,3 test as xlsm,4 as test as xlsb.
(but in csv format , no results)

The macro is working giving me as attached , but however I did find not the expected results file ??.

At least the message is appearing but unable to know where it has stored the file with requested results.

Kindly advise where I am going wrong
1 file converted.jpg
 
As I yet wrote, the csv test directory must contains only 2 files :
60033.csv and a brand new Excel workbook (empty) with Macro1 code …
Running this procedure creates workbook 60033.xlsx in same directory
as required in your initial post, same as your joined one
but without your error of row #168 !
Once it works, you could try with several csv text files in the directory …
​
 
Marc L said:
As I yet wrote, the csv test directory must contains only 2 files :
60033.csv and a brand new Excel workbook (empty) with Macro1 code …
Running this procedure creates workbook 60033.xlsx in same directory
as required in your initial post, same as your joined one
but without your error of row #168 !
Once it works, you could try with several csv text files in the directory …
​
Click to expand...

ok Marc :confused:,:( at least I have understand clearly your instructions , now it workings fine:):cool:

Thank you for your patience to solve this issue:awesome::awesome:
 

If all other csv text files have exactly same 60033 structure,
they will be saved as workbooks in one run.

But if you adapt jindon's code to do the same,
it may execute faster than my procedure …
​
 
RAM72 said:
Hi Jindon

Tested your code working as requested on 2016 excel will have to try excel 2007 at work and informed you
Click to expand...
Marc L said:
If all other csv text files have exactly same 60033 structure,
they will be saved as workbooks in one run.

But if you adapt jindon's code to do the same,
it may execute faster than my procedure …
​
Click to expand...

Marc and Jindon

I have another issues on the format structure , an insight from me:(,apologize sincerely,the interface generates csv files with different header ranges and summary headers where the invoice number must be extracted
the first one range headers was at Q, the other format headers are at AI and AG., the row headers and ranges differ:confused:

See attached summary file insight tab of the issues.

Is there a solution to modify the code on column C and D row changes
the ranges headers
the rows number changes at range headers

However ,same output results as first xlsx file
I would sincerely appreciate your help:(

https://www.dropbox.com/s/mg0yezu9gfjwqow/108952.csv?dl=0
https://www.dropbox.com/s/bu91iouujl1amfe/60084.csv?dl=0
 

Attachments

  • 60084&108952INSIGHT CSVOUTPUT INTERFACE.xlsx
    46.1 KB · Views: 1

As yet explained since post #2, you can attach files here !

Which issue ? In which code, from whom ?
Explain for each code if there is any problem within result workbooks !
​
 
Marc L said:
As yet explained since post #2, you can attach files here !

Which issue ? In which code, from whom ?
Explain for each code if there is any problem within result workbooks !
​
Click to expand...
Marc and Jindon kindly ignore my previous request for amendment

I have found the solution saving the csv twice just moves column C and D to require rows destiantion and applying both macro works smoothly

Thanks again for your valuable help

:)
 

Sorry but I didn't understand the « columns C and D row changes
the ranges headers » …
As my code works with your last csv joined files …
​
 
Marc L said:
Sorry but I didn't understand the « columns C and D row changes
the ranges headers » …
As my code works with your last csv joined files …
​
[/quo
Yes i do understand , what happens , the original csv interface file show different different row data position whih causes macro errors.
So in saving file again in csv format in excel it results from my first post attach dropbox file
The second and third dropbox file had difference as attached summary xlsx previous post butbwas not reflected in the dropbox file,
This is why your code and that of jindon worked flawlessly despite the header ranges were different ag and ai cells.

Thus from original csv file i just to resave csv in excel and applied macro and it works

I will post the screen shoot of the 2 original csv files for better understanding and after resaving in excel as i am away from computer
Click to expand...
 
You must log in or register to reply here.
Back
Top