I want to fill blank cells with the value above but only if the above cell is not a table header.
The user can select a range of cells. The code creates a table if is not a table already.
Maybe there would be better way like create the table if the user clicks a cell somewhere in the table.
The issue is that it will fill in blank cells with the value from the above cell as intended but if there is a blank in the second row then it copies the header there. I want to avoid that so I added a condition with function but then I get an error on the line where a cell is checked if it is a header.
Sub FillBlankCells()
' Prompt user to select a range of cells
Dim selRange As Range
Set selRange = Application.InputBox("Please select a range of cells to turn into a table:", Type:=8)
' Check if a table already exists in the selected range
Dim tbl As ListObject
On Error Resume Next
Set tbl = selRange.ListObject
On Error GoTo 0
' If a table doesn't exist, create a new table
If tbl Is Nothing Then
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, selRange, , xlYes)
End If
' Loop through each column in the table
Dim col As ListColumn
For Each col In tbl.ListColumns
' Loop through each row in the column
Dim row As Range
For Each row In col.Range.Rows
' If cell is blank and above cell is not a table header, fill with value from cell above
If IsEmpty(row.Value) And Not IsTableHeader(row.Offset(-1, 0), tbl) Then
row.Value = row.Offset(-1, 0).Value
End If
Next row
Next col
End Sub
Function IsTableHeader(cell As Range, tbl As ListObject) As Boolean
' Check if cell is a table header
If Not tbl Is Nothing Then
If cell.Address = tbl.HeaderRowRange.Cells(1).Address Then
IsTableHeader = True
Exit Function
End If
End If
IsTableHeader = False
End Function
If you want your code doing nothing in case of a blank cell bellow the header, please use the next adapted code, keeping from it as mutch as I could. It extracts the table DataBodyRange, resize it to exclude its first row and process it without any helping function:
Sub FillBlankCells()
' Prompt user to select a range of cells
Dim selRange As Range
Set selRange = Application.InputBox("Please select a range of cells to turn into a table:", Type:=8)
' Check if a table already exists in the selected range
Dim tbl As ListObject
On Error Resume Next
Set tbl = selRange.ListObject
On Error GoTo 0
' If a table doesn't exist, create a new table
If tbl Is Nothing Then
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, selRange, , xlYes)
End If
Dim dataBR As Range
Set dataBR = tbl.DataBodyRange
Set dataBR = dataBR.Resize(dataBR.rows.count - 1).Offset(1)
'Debug.Print dataBR.address: Stop 'just to see the range to be processed address
' Loop through each column in the table
Dim col As Range, row As Range
For Each col In dataBR.Columns
' Loop through each row in the column
For Each row In col.rows
' If cell is blank and above cell is not a table header, fill with value from cell above
If IsEmpty(row.Value) Then
row.Value = row.Offset(-1, 0).Value
End If
Next row
Next col
End Sub