PDA

View Full Version : [SOLVED] Help import from csv file



GhostofDoom
12-05-2019, 11:34 AM
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
12-05-2019, 07:18 PM
Sorry i forgot to remove the password of the file
here's the one without password.


'because i can't edit my post'

JKwan
12-06-2019, 07:46 AM
change your csv file extension to txt


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

GhostofDoom
12-06-2019, 10:35 AM
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
12-11-2019, 10:07 AM
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
12-16-2019, 11:16 AM
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
12-17-2019, 05:14 AM
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
12-17-2019, 08:33 AM
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
12-17-2019, 10:07 AM
Hello p45cal (http://www.vbaexpress.com/forum/member.php?3494-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
12-17-2019, 10:48 AM
try replacing:
.TextFileCommaDelimiter = Truewith:
.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
12-17-2019, 11:02 AM
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 :thumb

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
12-17-2019, 11:17 AM
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
12-17-2019, 11:29 AM
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 :thumb

p45cal
12-17-2019, 11:35 AM
Add
Intersect(.ResultRange.EntireRow, .Parent.Range("A:A")).Value = "RUNNING"
straight after:
.Refresh BackgroundQuery:=False

GhostofDoom
12-17-2019, 11:52 AM
awesome :yes
works like a charm

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

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
12-17-2019, 01:21 PM
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
12-17-2019, 08:15 PM
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 :thumb


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
12-17-2019, 09:33 PM
p45cal, i see when we import from a new file
we get the same ID numbers ?

any solution for that please

p45cal
12-18-2019, 03:54 AM
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
12-18-2019, 05:29 AM
hello p45cal,

awesome works like a charm :thumb

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.

p45cal
01-11-2020, 03:06 PM
I missed this additional question because you edited it 2+ hours after you first placed it and I got notified of a new post before that; so when I checked it there was no additional question!
Anyway, more than 3 weeks later, try:
Intersect(.ResultRange.EntireRow, .Parent.Range("Q:Q")).SpecialCells(xlCellTypeBlanks).Value = "x"

GhostofDoom
01-12-2020, 01:50 AM
Thank you p45cal :thumb

*solved*