listobject databodyrange columns question

[bnj1776]

Ran into a "feature" that I am curious about. If anyone has a better explanation please share.

In this process I am scanning every table in a workbook for a specific column heading (PartNumber) so that I can compare every part number found against the master list to make sure it exists there.

I found in testing the code that this line "seems" to work (tblbodyX is a Variant)

tblBodyX = loX.DataBodyRange.Columns(ColX)​

but that the following line gets an error

For RowX = LBound(tblBodyX) To UBound(tblBodyX)​

To make it work I had to change the code to look for the number of rows first. If just one row, load the entire table into tblBodyX, not just the column that I wanted. (See below)


What I see is that because I am only loading one row and one column (originally) that Excel failed to build an array (of one cell) within the variant field.

Is that correct or is there something else that I am missing???


Thank you,
Brian

    For Each wsX In wbX.Worksheets    
        Me.wsName.Caption = wsX.Name
        Me.tblName.Caption = vbNullString
        Call ShowDoStatus(Delay1, "Starting part number search in '" & wbX.Name & "' '" & wsX.Name & "' ...")
    
        If Not (wsX.Name Like ctbl_Parts) _
        And Not (wsX.Name Like ctbl_Parts_Use) _
        And Not (wsX.Name Like cFAQ) _
        And Not (wsX.Name Like cTOC) Then
        
            'worksheet found that may contain part number information
            For Each loX In wsX.ListObjects
            
                Me.tblName.Caption = loX.Name
                Call ShowDoStatus(Delay1, "Starting part number search in '" & wbX.Name & "' '" & wsX.Name & "' '" & loX.Name & "' ...")
                    
                tblHeaderX = loX.HeaderRowRange
                
                For ColX = LBound(tblHeaderX, 2) To UBound(tblHeaderX, 2)
                
                    'checking each column heading of every table for "PartNumber*" or  "Part Number*"
                    If tblHeaderX(1, ColX) Like cPartNumber & cAsterisk _
                    Or tblHeaderX(1, ColX) Like cPart_Number & cAsterisk Then
                    
                        Me.tblName.Caption = loX.Name
                        
                        If loX.DataBodyRange.Columns(ColX).Count > 1 Then
                            
                            tblBodyX = loX.DataBodyRange.Columns(ColX) 'moves only part numbers to array
                            ColX = 1 'column number has changed
                            
                        Else
                        
                            tblBodyX = loX.DataBodyRange 'only one record found, move entire table so that there is an array in variant
                        
                        End If
                        
                        For RowX = LBound(tblBodyX) To UBound(tblBodyX)
                        
                            If Trim(tblBodyX(RowX, ColX)) <> vbNullString Then
                            
                                Call tblPartsUse_Update
                                If Me.DoStatus.Caption Like cErrorMsg Then GoTo Exit_wbX_Scan
                                
                            End If
                            
                        Next RowX
                        
                    End If
                    
                    Exit For 'Next ColX
                
                Next ColX
            
            Next loX
        
        End If
    
    Next wsX

 

[Jon von der Heyden]

What if you use:

For RowX = LBound(tblBodyX[COLOR=#ff0000],1[/COLOR]) to UBound(tblBodyX[COLOR=#ff0000],1[/COLOR])

 

[bnj1776]

Tried that too. Same error.

 

[skywriter]

Excel failed to build an array (of one cell) within the variant field.

Which means since it was a variant it will just see the one cell and it will default to whatever the one cell is. If it's a string it will simply see it as a string, if it's a number it will default to the appropriate number type.

 

[LockeGarmin]

Here is a function that I came up with to gather the part numbers from all of the tables in a workbook and avoid some of the errors that come with zero or one row.

Function GetPartNumbersFromTables(WB As Workbook) As Variant

Dim WS As Worksheet
Dim Table As ListObject
Dim Cell As Range
Dim PartNumberDict As Object
Dim PartNumber As String

Const PartNumberColumnName As String = "PartNumber"

  Set PartNumberDict = CreateObject("Scripting.Dictionary")
  
  For Each WS In WB.Worksheets
    For Each Table In WS.ListObjects
      If Table.ListRows.Count > 0 And TableHasColumnName(Table, PartNumberColumnName) Then
        For Each Cell In Table.ListColumns(PartNumberColumnName).DataBodyRange
          PartNumber = Cell.Value2
          If Not PartNumberDict.Exists(PartNumber) Then
            PartNumberDict.Add PartNumber, vbNullString
          End If
        Next Cell
      End If
    Next Table
  Next WS
  
  GetPartNumbersFromTables = PartNumberDict.Keys

End Function

Function TableHasColumnName(Table As ListObject, ColumnName As String) As Boolean

  On Error Resume Next
  TableHasColumnName = Not Table.ListColumns(ColumnName) Is Nothing
  Err.Clear
  
End Function

You would then use it like the following:

Sub PrintPartNumbers()

Dim PartNumberList As Variant
Dim PartNumber As Variant

  PartNumberList = GetPartNumbersFromTables(ActiveWorkbook)
  
  For Each PartNumber In PartNumberList
    Debug.Print PartNumber
  Next PartNumber

End Sub

 

[Norie]

Couldn't you use IsArray?

If IsArray(tblBodyX) Then
    For RowX = LBound(tblBodyX) To UBound(tblBodyX)
        ' deal with array
    Next RowX
Else
    ' deal with single value
End If

 

[bnj1776]

Thank you all.

Which means since it was a variant it will just see the one cell and it will default to whatever the one cell is. If it's a string it will simply see it as a string, if it's a number it will default to the appropriate number type.

Good, it is not a "feature" then. It is behaving as expected. Okay, I can work with that. Thank you for the confirmation.

For Each Cell In Table.ListColumns(PartNumberColumnName).DataBodyRange

I like the idea here but for the number of entries I am dealing with. I would rather read blocks of the tables to speed the process along.

Couldn't you use IsArray?

Ends up being the same as...

If loX.DataBodyRange.Columns(ColX).Count > 1 Then

I've set up the scanning process to work with a column from the DataBodyRange, so moving just the cell's values (from Locke's suggestion and yours) still creates the issue with the value residing in a Variant. I could add a step and move to a separate non-table array then use that array, but already have the table-variant working now and a deadline. I'll have to give that method a try though and see if it works out to be quicker sometime.



Thanks again.
Brian

 

[Norie]

Brian

Glad you've got something working.

Still not sure why you are loading the entire table when there's only one row.

Can't you just handle the single value on its own without a loop?

 

[bnj1776]

The next process that checks and updates the part number list is using the single table column I pass to it (normally).

When there is only one row and I do this (pass just the column) it bombs because of the table variant issue (one cell) which it treats as a string, not a table array.
Thus the passing of that entire row (when there is only one). This "trick" gets me past the variant problem and lets me continue with the next step (without me rewriting).

I've got 15-20 "modular" workbooks each with many worksheets to scan.... yeah. So trying to keep this as streamlined as possible (and meet the requirement to display status constantly even though it can't be read unless your stepping though the code).

Below is the following update step if you care to check it out.
If I am missing something though, I would love to hear about it.

Thank you.
Brian

Private Sub tblPartsUse_Update()

    'Called by wbX_Scan


    Dim tmp                             As String
    
    Call ShowDoStatus(Delay1, "Searching '" & ctbl_Parts_Use & "' records for changes regarding " & _
                              "wb:'" & wbName & "' ws:'" & wsName & "' lo:'" & tblName & "' part:'" & tblBodyX(1, ColX) & "'")
    
    'Search existing records for a matching record; insert/add as needed
    For puRow = LBound(tblBody_PartsUse) To UBound(tblBody_PartsUse)
    
        Select Case True
    
            Case wbX.Name = tblBody_PartsUse(puRow, puCol_wbName) _
             And wsX.Name = tblBody_PartsUse(puRow, puCol_wsName) _
             And loX.Name = tblBody_PartsUse(puRow, puCol_tblName) _
             And IsNumeric(tblBodyX(RowX, ColX)) = IsNumeric(tblBody_PartsUse(puRow, puCol_tblName)) _
             And tblBodyX(RowX, ColX) = tblBody_PartsUse(puRow, puCol_PartNumber)
        
                msg = "Update part number..."
                puChangeType = cMod
                Exit For
        
        
            Case wbX.Name = tblBody_PartsUse(puRow, puCol_wbName) _
             And wsX.Name = tblBody_PartsUse(puRow, puCol_wsName) _
             And loX.Name = tblBody_PartsUse(puRow, puCol_tblName) _
             And IsNumeric(tblBodyX(RowX, ColX)) = IsNumeric(tblBody_PartsUse(puRow, puCol_tblName)) _
             And tblBodyX(RowX, ColX) < tblBody_PartsUse(puRow, puCol_PartNumber)
        
                msg = "Insert new part number..."
                puChangeType = cIns
                Exit For
                
                
            Case wbX.Name = tblBody_PartsUse(puRow, puCol_wbName) _
             And wsX.Name = tblBody_PartsUse(puRow, puCol_wsName) _
             And loX.Name = tblBody_PartsUse(puRow, puCol_tblName) _
             And IsNumeric(tblBodyX(RowX, ColX)) = True _
             And IsNumeric(tblBody_PartsUse(puRow, puCol_tblName)) = False


                msg = "Insert new numeric part number..."
                puChangeType = cIns
                Exit For
                
                
            Case wbX.Name = tblBody_PartsUse(puRow, puCol_wbName) _
             And wsX.Name = tblBody_PartsUse(puRow, puCol_wsName) _
             And loX.Name < tblBody_PartsUse(puRow, puCol_tblName)
            
                msg = "Insert new table and part number..."
                puChangeType = cIns
                Exit For
                
                
            Case wbX.Name = tblBody_PartsUse(puRow, puCol_wbName) _
             And wsX.Name < tblBody_PartsUse(puRow, puCol_wsName)
            
                msg = "Insert new worksheet, table and part number..."
                puChangeType = cIns
                Exit For
            
            
            Case wbX.Name < tblBody_PartsUse(puRow, puCol_wbName)
                
                'New workbook to be inserted before all other workbooks
                msg = "Insert new workbook, worksheet, table and part number..."
                puChangeType = cIns
                Exit For
        
        
            Case puRow = UBound(tblBody_PartsUse)
             
                'Have not found a place to insert this record, so add it to the end
                msg = "Add new workbook, worksheet, table and part number..."
                puChangeType = cAdd
                Exit For
            
            
        End Select
        
    Next puRow
    
    
    On Error GoTo ErrHandler_tblPartsUse_Update1
        Select Case puChangeType
            Case cMod
                Set lrPartsUse = loPartsUse.ListRows(puRow)
            Case cIns
                loPartsUse.ListRows(puRow).Range.Insert
                Set lrPartsUse = loPartsUse.ListRows(puRow)
            Case cAdd
                Set lrPartsUse = loPartsUse.ListRows.Add(AlwaysInsert:=True)
            Case Else
                Call ShowDoStatus(Delay1, cError & "Failed to set the Change Type (Add/Insert/Modify/Delete) for Row " & puRow)
        End Select
    On Error GoTo 0
    If Me.DoStatus.Caption Like cErrorMsg Then GoTo Exit_tblPartsUse_Update
    
    'Display the start message
    If DebugPrint = True Then
        Call ShowDoStatus(Delay1, msg)
    End If
    
    'Update the selected record
        
    On Error Resume Next 'Update optional table columns
        If puCol_Table > 0 Then lrPartsUse.Range.Cells(1, puCol_Table) = loPartsUse.Name
        If puCol_UpdatedOn > 0 Then lrPartsUse.Range.Cells(1, puCol_UpdatedOn) = Now
        If puCol_UpdatedBy > 0 Then lrPartsUse.Range.Cells(1, puCol_UpdatedBy) = Trim(Excel.Application.UserName)
    On Error GoTo 0
        
    On Error GoTo ErrHandler_tblPartsUse_Update2 'Update required table columns
        lrPartsUse.Range.Cells(1, puCol_wbName) = wbName
        lrPartsUse.Range.Cells(1, puCol_wsName) = wsName
        lrPartsUse.Range.Cells(1, puCol_tblName) = tblName
        lrPartsUse.Range.Cells(1, puCol_PartNumber) = tblBodyX(RowX, ColX)   'lrX.Range.Cells(1, ColX)
    On Error GoTo 0
    If Me.DoStatus.Caption Like cErrorMsg Then GoTo Exit_tblPartsUse_Update
    
    tmp = tblBodyX(RowX, ColX)
    Call tblParts_Check(tmp)


    If Me.DoStatus.Caption Like cErrorMsg Then GoTo Exit_tblPartsUse_Update
    
    'Display the end message
    If DebugPrint = True Then
        Call ShowDoStatus(Delay1, msg & " Complete")
    End If
    
    'Reload the Parts Use table to pick up the new records
    If puChangeType <> cMod Then
        Call tblPartsUse_Load
    End If


Exit_tblPartsUse_Update:


    Exit Sub 'do not fall into error handlers


ErrHandler_tblPartsUse_Update1:


    Call ShowDoStatus(Delay1, cError & "Failed to set the active list row to the current record in '" & loPartsUse.Name & "' Row " & puRow)
    Resume Next


ErrHandler_tblPartsUse_Update2:


    Call ShowDoStatus(Delay1, cError & "Failed to update the current record in '" & loPartsUse.Name & "' Row " & puRow)
    Resume Next


End Sub 'tblPartsUse_Update