My text file contains something like
a , b , c , d
I want to select only b and c
So far I already make macro that can read all data (a,b,c,d)
With ws.QueryTables.Add("TEXT;" & File, ws.Cells(1, 1))
.FieldNames = True
.AdjustColumnWidth = True
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileCommaDelimiter = True
.TextFileColumnDataTypes = columnFormats
.Refresh
End With
What I need to add for selecting b and c only?
Try adding:
.TextFileColumnDataTypes = Array(9, 1, 1, 9)
where 9 stands for skip
Related
I need query table data in excel to use comma as a delimiter for columns and curly bracket '{' as a delimiter for rows.
I know i can use the ".TextFileOtherDelimiter" property to use the curly bracket as a delimiter. But how do i get the data to go into the next row?
CODE
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & url & "", Destination:=Worksheets("temp").Range("$A$1"))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
End With
Above code works fine for splitting data by commas into different columns.
Do this first
Dim X As Variant
X = Split(Range("A1").Value, "{") 'or X = Split(YourVariable, "{")
Worksheets("temp").Range("$A$1").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
then run your text to columns code
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & url & "",
Destination:=Worksheets("temp").Range("$A$1"))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
End With
I have a sheet with Item names in the firs row.
I am using a Forloop to pass trough the cells in row 1 - i.
I use the value content of each cell to import a column from a .CSV file in the corresponding cell below it in row 2, by using j for that.
However, I have some .CSV files that are missing and I need to move on to the next cell in row 2, while moving on to the next cell in row 1. Basically skipping a column.
What I have so far is:
Dim FSO As Object
Dim Folder As Object
Dim File As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder("C:\Users\Betty\AppData\Roaming\MetaQuotes\Terminal\B4D9BCD10BE9B5248AFCB2BE2411BA10\MQL4\Files")
For i = 2 To HCP.Cells(1, HCP.Columns.Count).End(xlToLeft).Column
Item = HCP.Cells(1, i).Value
FilePath = Folder & "\" & Item & "1440.CSV"
If Item = "" Or Dir(FilePath) = "" Then GoTo Continue
j = HCP.Cells(2, HCP.Columns.Count).End(xlToLeft).Column
With HCP.QueryTables.Add(Connection:="TEXT;" & FilePath, Destination:=HCP.Cells(2, j + 1))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(9, 9, 9, 9, 9, 1, 9, 9, 9, 9)
.Refresh BackgroundQuery:=False
End With
Continue:
Next
I need the column index of j to be corresponding to the column index of i at all times.
I would avoid using GoTo Continue. Just check the negative of your statements before entering the loop. You are also missing some End If statement in both your question and solution.
I left comments showing where the code will skip to if either Item or Dir are blank. Same result, just cleaner code.
For i = 2 To HCP.Cells(1, HCP.Columns.Count).End(xlToLeft).Column
Item = HCP.Cells(1, i).Value
FilePath = Folder & "\" & Item & "1440.CSV"
If Item <> "" Or Dir(FilePath) <> "" Then 'Test Here
j = HCP.Cells(2, HCP.Columns.Count).End(xlToLeft).Column
If j <> i Then j = i
With HCP.QueryTables.Add(Connection:="TEXT;" & FilePath, Destination:=HCP.Cells(2, j))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(9, 9, 9, 9, 9, 1, 9, 9, 9, 9)
.Refresh BackgroundQuery:=False
End With
End If 'Skips to here if either are blank.
Next i
I figured it out. This is what I am using now.
For i = 2 To HCP.Cells(1, HCP.Columns.Count).End(xlToLeft).Column
Item = HCP.Cells(1, i).Value
FilePath = Folder & "\" & Item & "1440.CSV"
If Item = "" Or Dir(FilePath) = "" Then GoTo Continue
j = HCP.Cells(2, HCP.Columns.Count).End(xlToLeft).Column
If j <> i Then j = i
With HCP.QueryTables.Add(Connection:="TEXT;" & FilePath, Destination:=HCP.Cells(2, j))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(9, 9, 9, 9, 9, 1, 9, 9, 9, 9)
.Refresh BackgroundQuery:=False
End With
Continue:
Next
And this is the result:
Please, feel free to make any other suggestions.
Solution 3: Nested ForLoop with Nested IfStatement
For i = 1 To BS.Cells(1, BS.Columns.Count).End(xlToLeft).Column
For j = 1 To BS.Cells(2, BS.Columns.Count - 1).End(xlToLeft).Column
Item = BS.Cells(1, i).Value
FilePath = Folder & "\" & Item & "1440.CSV"
If ((Item <> "") Or (Dir(FilePath) <> "") And (i = j)) Then
With BS.QueryTables.Add(Connection:="TEXT;" & FilePath, Destination:=BS.Cells(2, j + 1))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(9, 9, 9, 9, 9, 1, 9, 9, 9, 9)
.Refresh BackgroundQuery:=False
End With
End If
Next j
Next i
Solution 2: Nested Do Loop
Avoiding the "Continue" command, as it is not a VBA command.
For i = 2 To BS.Cells(1, BS.Columns.Count).End(xlToLeft).Column: Do
Item = BS.Cells(1, i).Value
FilePath = Folder & "\" & Item & "1440.CSV"
If Item = "" Or Dir(FilePath) = "" Then Exit Do
j = BS.Cells(2, BS.Columns.Count).End(xlToLeft).Column
If j <> i Then j = i
With BS.QueryTables.Add(Connection:="TEXT;" & FilePath, Destination:=BS.Cells(2, j))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(9, 9, 9, 9, 9, 1, 9, 9, 9, 9)
.Refresh BackgroundQuery:=False
End With
Loop While False: Next i
Please, Notice the : Do at the end of the end of the For i.
If one of the following conditions, i.e. Item = "" or Dir(FilePath) = "" is False , then the Do loop is exited. True if the Loop While False: Next i condition for the Do loop is stated.
The two conditions may also be presented as:
For i = 2 To BS.Cells(1, BS.Columns.Count).End(xlToLeft).Column: Do
If Item <> "" Or Dir(FilePath) <> "" Then
'Do something...
Else: Exit Do
End If
Loop While True: Next i
Having the Or condition in the If Item = "" Or Dir(FilePath) = "" Then Exit Do is mandatory as i may be Value <> " ", but the FilePath to the file may be non-existent i.e. Dir(FilePath) = " ", which will spit out an error as the previous I had.
The If j <> i Then j = i in this case is mandatory, as the For i is stated as =2 To, meaning that the loop starts from column 2.
This can be avoided by stating the For i loop as For i = 1 To. However this was the initial loop to get the job done.
Further j can be stated as j = BS.Cells(2, i), obtaining the value of i for a column index.
However, the If j <> i Then j = i statement is advisable for further assurance purposes.
In further search more solutions emerged.
See Solution 3: Nested For Loop with Nested If Statement
I'm working on a lot of pcb projects and we have an excel file that we have to enter a lot of values by hand (A drill table actually). I've some issues now...
Macro Not Saving
When I create the macro that imports the text, I can save it but when I open the excel file again the macro is gone.
Here is the code that I'm using to import a file:
Option Explicit
Sub ImportTextFile()
Dim fName As String
fName = Application.GetOpenFilename("Text Files, *.tap; *.drl")
If fName = "False" Then Exit Sub
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fName, _
Destination:=Range("$A$1"))
.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 = True
.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
End Sub
Sorting Values
Once I have my report imported, it looks like this:
;HEADER: 271-138-131-011
;CODE : ASCII
;FILE : ncdrill-1-10.drl for ... layers TOP and BOTTOM
;DESIGN: 131-011.brd
;T01 Holesize 1. = 20.000000 Tolerance = +2.000000/-2.000000 PLATED MILS Quantity = 360
;T02 Holesize 2. = 24.000000 Tolerance = +2.000000/-2.000000 PLATED MILS Quantity = 712
;T03 Holesize 3. = 126.000000 Tolerance = +3.940000/-3.940000 PLATED MILS Quantity = 10
;T04 Holesize 4. = 79.000000 Tolerance = +3.000000/-3.000000 NON_PLATED MILS Quantity = 1
;T05 Holesize 5. = 118.000000 Tolerance = +0.000000/-0.000000 NON_PLATED MILS Quantity = 3
%
G90
T01
X-0017100Y0160000
X-0017000Y0180000
Y0200000
Y0220000...
I actually need to take out the size of the hole and the quantity. I used in a row this function to take the size out =IF(A18="";"";RIGHT((LEFT(A18;26));7)).
For the quantity I don't know how to do it.
Once I have my hole's size and the quantity, I would like to report them on a table.
What function or macro should I writte please ?
Thank you for your help.
I have written a visual basic macro to load a csv file into Excel that I use quite frequently.
Unfortunately, if the csv file contains quoted newlines, the result is different from what you would get if you opened the csv file directly with excel. Unlike the usual import facility, QueryTables.add() assumes any newline it runs into, whether quoted or not, is the end of the row.
Is there a way around this? I'd prefer a solution that did not involve pre-modifying the incoming csv files to remove the newlines, but I'm open to suggestions on that front as well. I do want to have newlines in the resulting excel file cells, though.
The relevant part of my macro:
Sub LoadMyFile()
' Query the table of interest
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
& ThisWorkbook.Path & "\" & Range("A1").Value & ".csv", _
Destination:=Range("$A$2"))
.Name = ActiveSheet.Name
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Here's an example csv file with quoted newlines
"firstCol","secondCol"
"name1","data
one"
"name
2","data two"
The macro reads the file name (minus the .csv extension) from cell A1 and assumes the csv file is in the same directory as the excel file containing the macro.
I'm using 32 bit Office Professional 2010 on a windows 7 machine.
the import of such CSV files (newlines in data-points) works only with Workbooks.Open and only with CSVs in the locale format (delimiter, text-delimiter), the Excel is used.
Set wb = Workbooks.Open(Filename:="C:\Users\axel\Desktop\test.csv", Local:=True)
aData = wb.Worksheets(1).UsedRange.Value
lRows = UBound(aData, 1)
lCols = UBound(aData, 2)
With ActiveSheet
.Range(.Cells(1, 1), .Cells(lRows, lCols)).Value = aData
End With
wb.Close
Greetings
Axel
Edit: the code previously provided was actually designed with the specific example you provided in mind, with 2 columns and a relatively small number of data in the source CSV. I have reviewed the code below to fit other possible scenarios - also including a number of optimizations for runtime efficiency as well.
Note I am not used to using the seeking facilities relating to the Open method that I am relying on here, and I still have a couple misgivings re the way they actually work in some contexts tbh, but after running a couple tests the code looks to work just fine.
Sub csvImportbis()
Dim s As String
Dim i As Long
Dim j As Long
Dim a() As String
myfile = FreeFile
i = 1
j = 1
'ENTER YOUR PATH/FILE NAME HERE
Open "YOUR_PATH/FILENAME" For Input As #myfile
Do Until EOF(myfile)
Do
Input #myfile, s
cur = Seek(myfile)
Seek myfile, cur - 1
i = i + 1
Loop While input(1, #myfile) <> vbLf
ReDim a(1 To i - 1, 1 To 10000)
i = 1
Seek #myfile, 1
Do Until EOF(myfile)
Input #myfile, a(i, j)
i = i + 1
If i > UBound(a, 1) Then
i = 1
j = j + 1
End If
If j > UBound(a, 2) Then
ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2) + 10000)
End If
Loop
Loop
Close #myfile
sup = j
ReDim Preserve a(1 To UBound(a, 1), 1 To sup)
'QUALIFY THE RANGE WITH YOUR WORKBOOK & WORKSHEET REFERENCES
Range("A1").Resize(sup, UBound(a, 1)) = WorksheetFunction.Transpose(a)
End Sub
For some reason this macro freezes EXCEL when I set the for home = X to XX loop to more than 10 iterations.
This code downloads a webpage into excel, extracts cells that contain either 'overall' or 'carried' and copy them into another sheet in the same workbook.
Thank you
Sub Macro1()
'
' Macro1 Macro
'
'
Dim home As Integer
Dim Calc_sheet As Worksheet
Dim score_count As Integer
Dim inspection_count As Integer
Dim output_rows As Integer
Dim output_columns As Integer
Dim date_columns As Integer
'Counting variables
score_count = 3
inspection_count = 8
'Output rows and columns starting values
output_rows = 3
output_columns = 3
date_columns = 8
For home = 20 To 23
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.XXXXXXXX.org.uk/directory/" & Sheets("Output").Cells(home, 1), Destination:=Range("$A$1") _
)
'.CommandType = 0
.Name = "Homes"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
For x = 20 To 250
Select Case Left(Cells(x, 1), 7)
'Is it a score?
Case Is = "Overall"
Cells(x, 1).Copy
Sheets("Output").Select
Cells(output_rows, output_columns).Select
ActiveSheet.Paste
output_columns = output_columns + 1
'Is it a date?
Case Is = "Carried"
Cells(x, 1).Copy
Sheets("Output").Select
Cells(output_rows, date_columns).Select
ActiveSheet.Paste
date_columns = date_columns + 1
Case Else
End Select
Sheets("Calc_sheet").Activate
Cells(x, 1).Activate
Next x
'Clean sheet
ActiveSheet.Cells.Delete
'Go back to top
Range("A1").Select
'Reset column count
output_columns = 3
date_columns = 8
output_rows = output_rows + 1
Next home
End Sub
I updated the code, try it again!
Try replacing your inner-loop with this one :
Dim wsC As Worksheet
Dim wsO As Worksheet
Set wsC = Worksheets("Calc_sheet")
Set wsO = Worksheets("Output")
For x = 20 To 250
yourContent = wsC.Cells(x, 1)
yourCase = Left(yourContent, 7)
Select Case yourCase
'Is it a score?
Case Is = "Overall"
wsO.Cells(output_rows, output_columns) = yourContent
output_columns = output_columns + 1
'Is it a date?
Case Is = "Carried"
wsO.Cells(output_rows, date_columns) = yourContent
date_columns = date_columns + 1
Case Else
End Select
Next x