Consulting

Results 1 to 3 of 3

Thread: Have this code/query select what ever the current table is as a range & process?

  1. #1
    VBAX Regular
    Joined
    Apr 2024
    Location
    UK
    Posts
    16
    Location

    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.


    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

  2. #2
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,910
    Sounds like a biggish project. I have lots of ideas but need to experiment. Could we have an example (or two) of this file: fileToOpen = Application.GetOpenFilename
    If it's sensitive and you don't want it in the public domain but you don't mind me seeing it, PM me here for a private email address.

    As an aside, this code:
    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
    can probably be replaced with:
    lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    With ws.Range("A1:C" & lastrow)
      .Value = Application.Trim(.Value)
    End With
    ws.Range("D:Z").Delete 'perhaps this line not needed
    which trims the values in situ.
    Last edited by p45cal; 06-23-2024 at 03:40 AM.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    VBAX Regular
    Joined
    Apr 2024
    Location
    UK
    Posts
    16
    Location
    Quote Originally Posted by p45cal View Post
    Sounds like a biggish project. I have lots of ideas but need to experiment. Could we have an example (or two) of this file: fileToOpen = Application.GetOpenFilename
    If it's sensitive and you don't want it in the public domain but you don't mind me seeing it, PM me here for a private email address.

    As an aside, this code:
    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
    can probably be replaced with:
    lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    With ws.Range("A1:C" & lastrow)
      .Value = Application.Trim(.Value)
    End With
    ws.Range("D:Z").Delete 'perhaps this line not needed
    which trims the values in situ.
    Thank p45cal

    I really appreciate your reply.

    Best regards

    Event.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •