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.
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.
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".
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
Reply With Quote
Originally Posted by p45cal
