Help import from csv file

[GhostofDoom]

Hello,

i was wondering if someone would look into my
file because i can't get the csv file added into my xmls file

it contains ,,,,
and i can't get it into the correct columns and i also like when we import other files it will be added under it and not overwrite the cells

i used a code from dragonwood
thank for the sharing

if anyone can help please

we have lots to ask for but first comes first

thanks

[GhostofDoom]

Sorry i forgot to remove the password of the file
here's the one without password.


'because i can't edit my post'

[JKwan]

change your csv file extension to txt

Workbooks.Open sTemperature, , , 4, , , , , ";"

[GhostofDoom]

change your csv file extension to txt

Workbooks.Open sTemperature, , , 4, , , , , ";"

Hello JKwan,

awesome, so whats the '4' be for?
and how can i add more after the existing records?
like when we have more files to import
the data will be overwritten and that's not really the idea

Thanks

[GhostofDoom]

Hello,

updated, this seems to be working
now my other question will be
how can i only select the columns i really want to import
instead all the columns?

like only B C H
to my sheet B C F

Dim wbMaster As Workbook
    Dim wbTemperature As Workbook
    Dim sTemperature As String
    Dim wsImport As Worksheet
    Dim destCell As Range


    Set wbMaster = ThisWorkbook
    Set wsImport = wbMaster.Worksheets("sheetlist2")
    Set destCell = Worksheets("sheetlist2").Cells(Rows.Count, "A").End(xlUp).Offset(1) 


    'Ask for temperature workbook name.
    sTemperature = Application.GetOpenFilename("Log Files (*.txt), *.txt")
    If sTemperature = "False" Then Exit Function
    
    Application.ScreenUpdating = False
    
    Workbooks.Open sTemperature, , , 4, , , , , ";"
    Set wbTemperature = ActiveWorkbook
    
    ActiveSheet.Cells(1, 1).CurrentRegion.Copy destCell.Cells(1, 1)
    wbTemperature.Close False
    wbMaster.Activate
    wsImport.Select
    Application.GoTo destCell.Range("A9")
    
    Application.ScreenUpdating = True

Thanks

[GhostofDoom]

Hello,

is there a way to ignore the first row like the header? from the csv file
because it always create the header again

Dim wbMaster As Workbook
    Dim wbTemperature As Workbook
    Dim sTemperature As String
    Dim wsImport As Worksheet
    Dim destCell As Range


    Set wbMaster = ThisWorkbook
    Set wsImport = wbMaster.Worksheets("sheetlist2")
    Set destCell = Worksheets("sheetlist2").Cells(Rows.Count, "A").End(xlUp).Offset(1) 


    'Ask for temperature workbook name.
    sTemperature = Application.GetOpenFilename("Log Files (*.txt), *.txt")
    If sTemperature = "False" Then Exit Function
    
    Application.ScreenUpdating = False
    
    Workbooks.Open sTemperature, , , 4, , , , , ";"
    Set wbTemperature = ActiveWorkbook
    
    ActiveSheet.Cells(1, 1).CurrentRegion.Copy destCell.Cells(1, 1)
    wbTemperature.Close False
    wbMaster.Activate
    wsImport.Select
    Application.GoTo destCell.Range("A9")
    
    Application.ScreenUpdating = True

Thank you

[GhostofDoom]

Hello,

i found some useful codes on the net
and seems i can ignore the header
but i can't get it on the A9 row

any help please?

 Dim txtFileName As Variant
    Dim destCell As Range
    
    Set destCell = Worksheets("TestingImport").Cells(Rows.Count, "A").End(xlUp).Offset(1) 
    
    txtFileName = Application.GetOpenFilename(FileFilter:="TXT Files (*.txt),*.txt", Title:="Select a TXT File", MultiSelect:=False)
    If txtFileName= False Then Exit Sub
    
    With destCell.Parent.QueryTables.Add(Connection:="TEXT;" & txtFileName, Destination:=destCell.Cells(1, 1))
        .TextFileStartRow = 2 'this leaves the header away
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .Refresh BackgroundQuery:=False
    End With
    destCell.Parent.QueryTables(1).Delete

my old code i can add -1 but above code won't let me

'old code
Set destCell = Worksheets("sheetlist2").Cells(Rows.Count, "A").End(xlUp).Offset(-1)

is it also possible when we import from a txt/csv to create automated id numbers?
like 1,2,3,4,5 on column R9
because i can't find anything how to make that happen.

Thanks

[p45cal]

something like this?:

Dim txtFileName As Variant
Dim destCell As Range
Dim qt
Set destCell = Worksheets("TestingImport").Range("A9")
    
txtFileName = Application.GetOpenFilename(FileFilter:="TXT Files (*.txt),*.txt", Title:="Select a TXT File", MultiSelect:=False)
If txtFileName = False Then Exit Sub
    
Set qt = destCell.Parent.QueryTables.Add(Connection:="TEXT;" & txtFileName, Destination:=destCell.Cells(1, 1))
With qt
  .TextFileStartRow = 2    'this leaves the header away
  .TextFileParseType = xlDelimited
  .TextFileCommaDelimiter = True
  .Refresh BackgroundQuery:=False
  With Intersect(.ResultRange.EntireRow, .Parent.Range("R:R"))
    .Cells(1) = 1
    .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
  End With
End With
destCell.Parent.QueryTables(1).Delete

[GhostofDoom]

Hello p45cal ,

the data isn't adding to my column
the first row is okay then it just past beside them not over the columns
and no automated id numbers has been created stay 00

[p45cal]

try replacing:

  .TextFileCommaDelimiter = True

with:

  .TextFileOtherDelimiter = ";"

(or just add that line before .refresh.

Is column R blank where you're wanting the id numbers? If not you can delete them first with a ClearContents:

Dim txtFileName As Variant
Dim destCell As Range
Dim qt
Set destCell = Worksheets("TestingImport").Cells(Rows.Count, "A").End(xlUp).Offset(1)
If destCell.Row < 9 Then Set destCell = Worksheets("TestingImport").Range("A9")
    
txtFileName = Application.GetOpenFilename(FileFilter:="TXT Files (*.txt),*.txt", Title:="Select a TXT File", MultiSelect:=False)
If txtFileName = False Then Exit Sub
    
Set qt = destCell.Parent.QueryTables.Add(Connection:="TEXT;" & txtFileName, Destination:=destCell.Cells(1, 1))
With qt
  .TextFileStartRow = 2    'this leaves the header away
  .TextFileParseType = xlDelimited
  .TextFileCommaDelimiter = True 'you might not need this line at all - it might even be better to make it False
  .TextFileOtherDelimiter = ";"    'add or replace line above
  .RefreshStyle = xlOverwriteCells    '<<changed/added
  .Refresh BackgroundQuery:=False
  With Intersect(.ResultRange.EntireRow, .Parent.Range("R:R"))
    .ClearContents    '<<add
    .Cells(1) = 1
    .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
  End With
End With
destCell.Parent.QueryTables(1).Delete

[GhostofDoom]

awesome

but still don't get at row A9
as you can see i created a table
so it suppose to be in that table so after i add more it just expand

and thanks id numbers working

one more thing,

how can i when making a new column will be A
its empty because no data has CSV for that column
how can i add some text when import it to fill A with for example running

thanks

[p45cal]

I don't really understand.
The two lines:

Set destCell = Worksheets("TestingImport").Cells(Rows.Count, "A").End(xlUp).Offset(1)
If destCell.Row < 9 Then Set destCell = Worksheets("TestingImport").Range("A9")

depend on something being in column A each time, if there's always something in ALL rows in column B after the import you can change those two lines to:

Set destCell = Worksheets("TestingImport").Cells(Rows.Count, "B").End(xlUp).Offset(1, -1)
If destCell.Row < 9 Then Set destCell = Worksheets("TestingImport").Range("A9")

[GhostofDoom]

no worries P45cal,

okay i have added a new column so we have A again and we starting at column B from CSV file
but column A is empty

so my question will be
how can i add in column A the string RUNNING
when we import the CSV so the column A will not be empty anymore

edit:
cool i have the first part working

[p45cal]

Add

  Intersect(.ResultRange.EntireRow, .Parent.Range("A:A")).Value = "RUNNING"

straight after:

.Refresh BackgroundQuery:=False

[GhostofDoom]

awesome
works like a charm

but still the first row won't work
when i try again it starts again under my table

so i get always 1 empty line
just under the black line of my table instead inside of it


here my sheet
sorry can't add my CSV file for privacy reasons

[p45cal]

A querytable can't overlap an Excel Table (listobject) and an empty table has at least two rows: header and empty data row.
So all we can do is let it put the querytable where it wants to, then delete the querytable then extend the Excel Table, then delete all blank rows from the table:

Sub Append_CSV_File()    ''working from vbaexpress.com
Dim txtFileName As Variant
Dim destCell As Range
Dim qt
Set destCell = Worksheets("TestingImport").Cells(Rows.Count, "B").End(xlUp).Offset(1)
If destCell.Row < 9 Then Set destCell = Worksheets("TestingImport").Range("B9")

txtFileName = Application.GetOpenFilename(FileFilter:="TXT Files (*.txt),*.txt", Title:="Select a TXT File", MultiSelect:=False)
If txtFileName = False Then Exit Sub
    
Set qt = destCell.Parent.QueryTables.Add(Connection:="TEXT;" & txtFileName, Destination:=destCell.Cells(1, 1))
With qt
  .TextFileStartRow = 2    'this leaves the header away
  .TextFileParseType = xlDelimited
  .TextFileCommaDelimiter = False    'you might not need this line at all - it might even be better to make it False
  .TextFileOtherDelimiter = Empty
  .TextFileSemicolonDelimiter = True
  .RefreshStyle = xlOverwriteCells    '<<changed/added
  .Refresh BackgroundQuery:=False
  With Intersect(.ResultRange.EntireRow, .Parent.Range("S:S"))
    .ClearContents    '<<add
    .Cells(1) = 1
    .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
  End With
  Intersect(.ResultRange.EntireRow, .Parent.Range("A:A")).Value = "running"
  lr = .ResultRange.Rows(.ResultRange.Rows.Count).Row
  .WorkbookConnection.Delete
  .Delete
End With
With Worksheets("TestingImport").Range("B9").ListObject
  Set TL = .Range.Cells(1)
  lc = TL.Column + .ListColumns.Count - 1
  .Resize Range(TL, .Parent.Cells(lr, lc))
  'delete all blank rows in the table:
  For i = .ListRows.Count To 1 Step -1
    With .ListRows(i)
      If Application.CountA(.Range) = 0 Then .Delete
    End With
  Next i
End With
End Sub

The attached has the code in a separate module rather than in the ThisWorkbook code-module.

[GhostofDoom]

Hello p45cal,

ooh sorry i didn't really know about that
thanks for telling me.

wow cool your sheet is working awesome
but when i copy your code i get an error and then by TL ect...

Thank for the wonderful help


edit:

Found the problem,
it seems i can't use the
Option Explicit

in the module

Thanks p45cal for the awesome help
you are great

[GhostofDoom]

p45cal, i see when we import from a new file
we get the same ID numbers ?

any solution for that please

[p45cal]

p45cal, i see when we import from a new file
we get the same ID numbers ?

any solution for that please

Change:
.Cells(1) = 1
to:
.Cells(1) = .Cells(1).Offset(-1).Value + 1

[GhostofDoom]

hello p45cal,

awesome works like a charm

thanks alot

edit:

one more question, how can i ignore when the row is not empty
because with this code

  Intersect(.ResultRange.EntireRow, .Parent.Range("Q:Q")).Value = "x"

it overwrite any row if it contains already something from our csv file
we have the Q column v in the fields
i want to ignore that and only add x if empty


Thank you.