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
Related
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 getting a type mismatch while searching through a cell for a period "." or "p". It worked when I only used the "." but after adding "p" I get a type mismatch. Is a Variant/Empty for my_txt only able to use integers and "."s? I'm trying to have my filter use .'s or p's to determine the outline level.
Sub ProcessDocV5()
Dim Level As Range
Dim i, j, q(1 To 50) As Long
Dim numofchar As Long
Dim filepath As String
Dim filename As String
Dim LastRow As Long
Dim rowcallout As Long
Dim columncallout As Long
'scanf(Input the correct row and column numbers).
rowcallout = InputBox("LOCATION ROW OF HEADERS?")
columncallout = InputBox("LOCATION COLUMN OUTLINE? (A=1, B=2, ect...)")
Debug.Print "rowcallout value is "; [rowcallout]
Debug.Print "columncallout value is "; [columncallout]
'END OF SCAN
'ADJUST EXCEL SCREEN
'stop screen updating
Application.ScreenUpdating = False
'show gridlines
ActiveWindow.DisplayGridlines = True
'remove borders
ActiveWindow.DisplayGridlines = True
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'group according to level column (Cell(row,column))
Set Level = Range(Cells(rowcallout, columncallout), Cells(873, 2))
Debug.Print "The value of Levels is "; Level.Address
For i = rowcallout To Level.count
Cells(i, columncallout).Select
a = Len(Cells(i, columncallout))
Debug.Print "A value is "; [a]
my_txt = Replace(Cells(i, columncallout), "." Or "p", "", 1, -1, vbTextCompare)
b = Len(my_txt)
Debug.Print "B value is "; [b]
numb_occur = a - b + 1
Debug.Print [numb_occur]
If numb_occur < 8 Then
Rows(i).OutlineLevel = numb_occur - 1
Else
Rows(i).OutlineLevel = 8
End If
Next i
With ActiveSheet.Outline
.AutomaticStyles = False
.SummaryRow = xlAbove
.SummaryColumn = xlRight
End With
'Close tabs for neatness
ActiveSheet.Outline.ShowLevels RowLevels:=8
ActiveSheet.Outline.ShowLevels RowLevels:=7
ActiveSheet.Outline.ShowLevels RowLevels:=6
ActiveSheet.Outline.ShowLevels RowLevels:=5
ActiveSheet.Outline.ShowLevels RowLevels:=4
ActiveSheet.Outline.ShowLevels RowLevels:=3
ActiveSheet.Outline.ShowLevels RowLevels:=2
ActiveSheet.Outline.ShowLevels RowLevels:=1
End Sub
That's a lot of irrelevant code, but I managed to dig this one up:
my_txt = Replace(Cells(i, columncallout), "." Or "p", "", 1, -1, vbTextCompare)
"." Or "p" is an expression that VBA can't evaluate. The following is all we needed to see:
Debug.Print "." Or "p"
This instruction reproduces the exact problem you're having: a type mismatch error.
Or is a logical binary operator that, when used as such, evaluates to True or False. When used as a bitwise operator it can evaluate to a Long, but while VBA does a lot of implicit type conversions for us, there's a limit to it, and "." and "p" can't be converted to Long or Boolean values, so VBA throws this type mismatch error, saying "I don't know what to do with this".
Run both replacements sucessively instead:
my_txt = Replace(Cells(i, columncallout), ".", "", 1, -1, vbTextCompare)
my_txt = Replace(my_txt, "p", "", 1, -1, vbTextCompare)
Unrelated, but must read:
How to avoid using Select in Excel VBA macros
Why does Range work, but not Cells?
I need to find various data in a sheet and select those data and print the selected data to printout and all data to be printed in one page. I tried with this code but something is wrong:
Sub Selection()
Dim varRow As String
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
If Range("A" & i).Value = "M655" Or Range("A" & i).Value = "Equity Fund" Then
If Trim(varRow) <> "" Then
varRow = varRow & "," & i & ":" & i
Else
varRow = varRow & i & ":" & i
End If
End If
Next i
Range(varRow).Select
Selection.PrintOut
With ActiveSheet.PageSetup
.PrintTitleRows = "$3:$3"
.PrintTitleColumns = "$B:$B"
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End with
End Sub
One issue is that after you loop through the cells, varRow is a string of "M655" and "Equity Fund" separated by commas. You then try to use that string as an argument for a range which is invalid. If you are trying to build a a string of range addresses ("a1", "a2", etc) try using the .AddressLocal property. Also, you use .PrintOut prior to setting the print settings. Try putting that line after you set the page setup settings to have them take effect.
I have the code of this macro which removes leading and trailing spaces in cells with text or numbers:
Sub LIMPIAR()
Dim i As Integer
For i = 2 To 20628
Cells(i, 7).Value = Trim(Cells(i, 6).Value)
Next
End Sub
However , there are cells which its content is " ". So I would like to convert that kind of cells to "". How Can I do that?
EDIT: I'm working with scraped data.
Maybe dealing with them like this can help:
If Len(Cells(i,6).Value) <= 2 Then Cells(i, 7).Value = "" End If
OR
If Cells(i,6).Value = " " Then Cells(i, 7).Value = "" End If
Not a very elagent solution, but I would make use of the split function and then reconcatenate the elements of the resulting array. Assuming your string is in cell A1,
mystring = ""
myarray = Split(Cells(1, 1), " ")
For i = LBound(myarray) To UBound(myarray)
If Trim(myarray(i)) <> "" Then
mystring = mystring & Trim(myarray(i)) & " "
End If
Next i
MsgBox Trim(mystring)
mystring should provide a string with just one space between words. You could put this code inside your loop.
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