Shift up cells when there is empty cell instead of delete entire row.

[sebekkg]

I have a table that i need to use as a parameter table for power query, now i want to create vba code that will run query refresh and to see if there are empty cells in parameter table so it can shift cells up.

so when there is a, null, b, c, null, d, e -> a, b, c, d, e. And after it to reduce rows of the table to be row_nr of cell E, and add one (just in case for further addition of values for parameters.

 

[sebekkg]

Here is what finaly ended up working for me::

Sub Refresh_data()
    ' Refresh Query - Raw_data
    ThisWorkbook.Connections("Query - Raw_data").Refresh

    ' Wait until the refresh of Query - Raw_data is complete
    Do While QueryIsRefreshing("Query - Raw_data")
        DoEvents
    Loop

    ' Refresh Query - B_o and Query - F_a
    ThisWorkbook.Connections("Query - BO").Refresh
    ThisWorkbook.Connections("Query - FA").Refresh
    
    ' Shift data up
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim dataArr() As Variant
    Dim lastRow As Long
    Dim lastCol As Long
    Dim i As Long
    Dim j As Long
    Dim k As Long
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("List_for_query")
    
    ' Set the table
    Set tbl = ws.ListObjects("WantedTable")
    
    ' Remove duplicates from the ID column
    tbl.ListColumns("ID").DataBodyRange.RemoveDuplicates Columns:=1, Header:=xlYes
    
    
    ' Find the last row and column in the WantedTable table
    lastRow = tbl.ListRows.Count
    lastCol = tbl.ListColumns.Count
    
    ' Read the data into an array
    dataArr = tbl.DataBodyRange.Value
    
    ' Loop through each column
    For j = 1 To lastCol
        ' Loop through each row from top to bottom
        For i = 1 To lastRow
            ' Check if the cell is empty
            If Len(Trim(dataArr(i, j))) = 0 Then
                ' Shift every cell with a higher row number up by one row
                For k = i + 1 To lastRow
                    ' Move the value instead of copying
                    dataArr(k - 1, j) = dataArr(k, j)
                Next k
                ' Clear the last row after shifting
                dataArr(lastRow, j) = ""
            End If
        Next i
    Next j
    
    ' Update the table with the modified array
    tbl.DataBodyRange.Value = dataArr
    
    ' Count the number of rows with data
    Dim numRowsWithData As Long
    For i = 1 To lastRow
        If Len(Trim(tbl.ListColumns(1).DataBodyRange.Cells(i, 1).Value)) > 0 Then
            numRowsWithData = numRowsWithData + 1
        End If
    Next i
    
    ' Set the final length of the table
    Dim final_len As Long
    final_len = numRowsWithData + 1
    
    ' Set the number of rows in the table
    tbl.Resize tbl.Range.Resize(final_len)
    
    ' Add a new row to the table
    tbl.ListRows.Add
    
    ' Sort the ID column in ascending order directly in the worksheet range
    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add Key:=tbl.ListColumns("ID").DataBodyRange, _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ws.Sort
        .SetRange tbl.Range
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Exit Sub
    
    
    
End Sub


Function QueryIsRefreshing(queryName As String) As Boolean
    Dim query As WorkbookQuery

    For Each query In ThisWorkbook.Queries
        If query.Name = queryName Then
            QueryIsRefreshing = query.Refreshing
            Exit Function
        End If
    Next query

    ' Return False if the query is not found
    QueryIsRefreshing = False
End Function