Have this code/query select what ever the current table is as a range & process?
How do I have this code/query select what ever the current table is as a range, process according to the code below but STOP power
query from advancing the number in the table name as I want it to reset it so that it is always "Table" to stop table name "bloat".
I have to import delimted text files at least once a day if not more.
They are rather large and produced on another machine that I have no control over so the data needs cleaning and manipulating before
I can use it so I am trying to automate it with 3 distinct processes which, once each process is tested and working, will be merged
into one seemless sub.
My methodology is as follows.
Sub 1.
a. Imports my chosen text file (using a file chooser dialogue),
b. Performs various actions to delimit, select and remove unwanted rows, then formats, prepares and ends with data for power query
selected as a range and preferably converted to a table always named "Table1".
Sub 2.
This Sub should contain the method to call the power query and have IT select the "Table 1" as its data source as well as the VBA that
specifys the directions to the query (as per the code further down recorded as I manually operated the query)'
Sub 3.
This sub further processes the data but would be run AFTER the Query had completed so I have not included it here as it is quite long.
The finished data, once I have processed it using the below subs ends up being 30,000 + rows so you can see why I am automating it.
I have had great success with the first and third processes but the 2nd, running a power query eludes my VBA attempts.
As the text file needs cleaning up. unwanted rows removed and so on that can not be down in a power Query as it needs to be done by eye,
I have a sub that imports which ever text file I choose and then performs various tasks before I skim over the sheet ready to transform
the data with a power query.
Excuse the comments and notes within the code as this is a work in progress and the comment are so that I do not forget what it all does.
I will neaten it all in the final code.
As ever, I am very gratful to any and every member who kindly gives their time to assist.
This Sub works perferctly and I include it in this post so that any reader may see what I do up to the point of opening Power Query.
If this is of no interest then please skip over this part.
Code:
Sub ImportTextFile()
Dim fileToOpen As Variant
Dim ws As Worksheet
Dim lastRow As Long
Dim cell As Range
Dim rowNum As Long
Dim i As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
' IMPORTS THE SELECTED DELIMITED TEXT FILE
fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Select Text File to Import", , False)
If fileToOpen <> "False" Then
Set ws = ThisWorkbook.Sheets("Import")
ws.Cells.Clear
With ws.QueryTables.Add(Connection:="TEXT;" & fileToOpen, Destination:=ws.Range("A2"))
.TextFileParseType = xlDelimited
.TextFileConsecutiveDelimiter = False
.TextFileOtherDelimiter = ":"
.TextFileColumnDataTypes = Array(1)
.Refresh
End With
lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
ws.Range("A1:A" & lastRow).TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=False, Other:=True, OtherChar:=":", FieldInfo:=Array(Array(1, 1))
ws.Columns("D:ZZ").ClearContents
End If
' TRIMS THE LEADING AND TRAILING SPACES FROM CELL CONTENTS
lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
ws.Range("S1:S" & lastRow).Formula = "=TRIM(A1)"
ws.Range("T1:T" & lastRow).Formula = "=TRIM(B1)"
ws.Range("U1:U" & lastRow).Formula = "=TRIM(C1)"
ws.Range("S1:U" & lastRow).Copy
ws.Range("AA1").PasteSpecial Paste:=xlPasteValues
ws.Range("A:Z").Delete
' MARKS UNWANTED ROWS FOR DELETION
For rowNum = 1 To lastRow
If ws.Cells(rowNum, 1).Value = "Complete name" Then
If rowNum >= 3 Then
If ws.Cells(rowNum - 2, 1).Value = "" And ws.Cells(rowNum + 2, 1).Value = "" Then
For Each cell In ws.Range(ws.Cells(rowNum - 1, 1), ws.Cells(rowNum + 1, 1))
cell.Value = "Delete"
cell.Interior.Color = RGB(255, 255, 0) ' Yellow color
Next cell
End If
End If
End If
Next rowNum
' DELETE UNWANTED ROWS
lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).Row
For i = lastRow To 1 Step -1
If ws.Cells(i, 1).Value = "Delete" Then
ws.Rows(i).Delete
End If
Next i
' MOVES VALUES FROM COLUMN C AND REPLACES THOSE IN COLUMN B, THEN REMOVES THE OLD COLUMN C.
' Find the last used row in Column C
lastRow = ws.Cells(ws.Rows.count, "C").End(xlUp).Row
' Loop through each row from 1 to the last used row
For i = 1 To lastRow
If ws.Cells(i, 3) <> "" Then ' Check if Cell in Column C is not blank
ws.Cells(i, 2).Value = ws.Cells(i, 3).Value ' Copy value to adjacent cell in Column B
End If
Next i
Columns("C").Delete
'-------------------------------------------------------
' THIS SELECTS THE CELLS IN THE IMPORT WORKSHEET READY TO CONVERT IT TO A TABLE.
Dim firstCell As Range
Dim selectedRange As Range
' Find the last used row in column A
lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).Row
' Find the first used cell in column A
Set firstCell = ws.Columns("A").Find("*", LookIn:=xlValues, LookAt:=xlPart)
' Check if a used cell is found
If Not firstCell Is Nothing Then
' Check if there is at least one value in Column A
If lastRow > 1 Then
' Combine both cells in-between first and last used cells, along with B column cells
Set selectedRange = ws.Range(ws.Cells(firstCell.Row, 1), ws.Cells(lastRow - 1, 1)).Resize(, 2)
' Select the range
selectedRange.Select
Else
MsgBox "Column A has no data.", vbExclamation
End If
Else
MsgBox "No data found in column A of the 'Import' worksheet."
End If
'--------------------------------------------------------
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
First Problem - Importing multiple text files, one after the other.
Once I have imported a txt file, cleaned and prepared it for a power query, selected the data as a range, converted it to a table, Ctrl + T so that Power Query
can use it eaiser, and copied the resulting power query back into an Excel worksheet, I then use "Table to Range" manually remove any connections, and then run the sub below.
When I then import the next text file, run the first sub above on it and then select the data as a range, when I try Ctrl + T Excel will not allow me to convert it to a table.
I do not use tables in this worksheet except when passing the data to the query, and when the query writes the result back to a new worksheet.
Once that is done I need to remove all data connections, references to tables and basicly return the work book back to as if no tables data connections had been used.
I Have to close and then reopen the whole workbook after converting previous table created by the power query to a range text before Excel allows me to do it again.
This means, continious, importing of different text files is not possible.
I tried to correct it using the code below but it hs not cured the issue.
Code:
Sub RevC_ConvertTablesToRangeAndClear()
On Error Resume Next ' Add error handling
Dim ws As Worksheet
Dim tbl As ListObject
Dim pt As PivotTable
Application.ScreenUpdating = False
' Loop through each worksheet in the workbook
For Each ws In ThisWorkbook.Worksheets
' Loop through each table in the worksheet
For Each tbl In ws.ListObjects
' Convert table to range
tbl.Unlist
Next tbl
Next ws
' Clear all data connections
Dim conn As WorkbookConnection
For Each conn In ThisWorkbook.Connections
conn.Delete
Next conn
' Clear all queries
Dim q As QueryTable
For Each q In ThisWorkbook.Queries
q.Delete
Next q
' Clear all relationships in Data Model
Dim rel As ModelRelationship
For Each rel In ThisWorkbook.Model.ModelRelationships
rel.Delete
Next rel
' Clear any PivotTables in the workbook
For Each ws In ThisWorkbook.Worksheets
For Each pt In ws.PivotTables
pt.TableRange2.Clear
Next pt
Next ws
Application.ScreenUpdating = True
End Sub
2nd Problem - Having to manually edit Power Query to remove rows and columns that I do not need and how to automate everything that powery query does.
If I can cure the issue in the 1st problem, then I will not need to close and reopen the whole workbook inbetween importing more than one file.
I do not know how to call or open Power query, and once open then perform a power Query based on or useing the recorded actions below which, once the
finished query has been written as a table, removes the formatting.
This is a straight macro recording of the range being converted to a table, opening power query, removing columns I do not need, adding an index column,
pivoting the table, filling the data up on specifc columns, deleting "null" rows, and writing the result back to a new worksheet and then removing the
formatting that PQ applies.
Having the first sub, after it has performed its tasks leaves the data in a selected range, which is handy when calling Power Query as the range of cells
will vary greatly from text sheet to text sheet as it is all ready selected.
How do I have this code/query select what ever the current table is as a range, process according to the code below but STOP power query from advancing the
number in the table name as I want it to reset it so that it is always "Table" to stop table name "bloat".
Code:
Sub A_PowerQuery()
'
' A_PowerQuery Macro
'
Application.CutCopyMode = False
Selection.Copy
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$3:$B$296249"), , xlNo).Name _
= "Table3"
Range("Table3[#All]").Select
ActiveWorkbook.Queries.Add Name:="Table3", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Excel.CurrentWorkbook(){[Name=""Table3""]}[Content]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Source,{{""Column1"", type text}, {""Column2"", type any}})," & Chr(13) & "" & Chr(10) & " #""Filtered Rows"" = Table.SelectRows(#""Changed Type"", each ([Column1] = ""Bit depth"" or [Column1] = ""Channel(s)"" or [Column1] = ""Complete name"" or [Column1] = ""Duration""" & _
" or [Column1] = ""Format profile"" or [Column1] = ""Sampling rate""))," & Chr(13) & "" & Chr(10) & " #""Added Index"" = Table.AddIndexColumn(#""Filtered Rows"", ""Index"", 1, 1, Int64.Type)," & Chr(13) & "" & Chr(10) & " #""Pivoted Column"" = Table.Pivot(#""Added Index"", List.Distinct(#""Added Index""[Column1]), ""Column1"", ""Column2"")," & Chr(13) & "" & Chr(10) & " #""Filled Up"" = Table.FillUp(#""Pivoted Column"",{""Duration"", ""Chan" & _
"nel(s)"", ""Sampling rate"", ""Bit depth"", ""Format profile""})," & Chr(13) & "" & Chr(10) & " #""Filtered Rows1"" = Table.SelectRows(#""Filled Up"", each ([Complete name] <> null))," & Chr(13) & "" & Chr(10) & " #""Removed Columns"" = Table.RemoveColumns(#""Filtered Rows1"",{""Index""})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Removed Columns"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Table3;Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table3]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table3_2"
.Refresh BackgroundQuery:=False
End With
ActiveSheet.ListObjects("Table3_2").Unlist
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
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.colorIndex = xlAutomatic
.TintAndShade = 0
End With
'<<<<<<< THIRD SUB WLL BE CALLED OR MERGED FROM HERE >>>>>>>
End Sub
