The following code loads a table for "Contact Types" (Customer, Vendor, Shipper, etc.)
While trying to bulletproof the code I discovered that when the table is empty that this line generates an unexpected result:
row_ContactType = .Range.Rows.Count - 1 'Do not count the header"
The count will still be 1 even though the table is empty.
What I'm doing...
On the first attempt to load the table I am after "active records" only and perform this check after the auto filter:
row_ContactType = .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count - 1 'Do not count the header
This check of the table with an auto filter works. With no active records found it returns a zero count as expected.
Knowing that there are no active records, I attempt to read again for all records (active and inactive) without an auto filter.
However, if the table is actually empty, the count will still be "1" and attempting to load the table to the array will fail.
So I added the final test for an empty table and was able to insert a new row (see blue code below) when needed.
This is working, but I'm a bit confused as to why it works this way.
Such as why I'm still getting a count of "1" when there is a blank record that can not be loaded into the array?
Is there something I'm missing here that would clean up this code?
For the "working" code I have already moved the "Test for empty table" section to the top of the load data subroutine and removed the second row count check (red code).
Any information or ideas would be helpful.
Thanks,
Brian
While trying to bulletproof the code I discovered that when the table is empty that this line generates an unexpected result:
row_ContactType = .Range.Rows.Count - 1 'Do not count the header"
The count will still be 1 even though the table is empty.
What I'm doing...
On the first attempt to load the table I am after "active records" only and perform this check after the auto filter:
row_ContactType = .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count - 1 'Do not count the header
This check of the table with an auto filter works. With no active records found it returns a zero count as expected.
Knowing that there are no active records, I attempt to read again for all records (active and inactive) without an auto filter.
However, if the table is actually empty, the count will still be "1" and attempting to load the table to the array will fail.
So I added the final test for an empty table and was able to insert a new row (see blue code below) when needed.
This is working, but I'm a bit confused as to why it works this way.
Such as why I'm still getting a count of "1" when there is a blank record that can not be loaded into the array?
Is there something I'm missing here that would clean up this code?
For the "working" code I have already moved the "Test for empty table" section to the top of the load data subroutine and removed the second row count check (red code).
Any information or ideas would be helpful.
Thanks,
Brian
Code:
[B]Private Sub UserForm_Activate()[/B]
' Load the contact type file - retrieve the worksheet into a list object
Set loContactType = tbl_ContactType.ListObjects("tblContactType")
' Create an array of the table header row
vContactTypeHeaders = loContactType.HeaderRowRange
' Get the column numbers (as the columns may be moved)
col_lContactTypeID = Array_GetHeaderColNum("lContactTypeID", vContactTypeHeaders)
col_sStatus = Array_GetHeaderColNum("sStatus", vContactTypeHeaders)
col_dtUpdated = Array_GetHeaderColNum("dtUpdated", vContactTypeHeaders)
col_sName = Array_GetHeaderColNum("sName", vContactTypeHeaders)
col_sDescription = Array_GetHeaderColNum("sDescription", vContactTypeHeaders)
fmContactType_CheckBox_IncludeInactive.Value = False 'Inactived ContactType not included in inital load
Call fmContactType_LoadData
... display screen...
End Sub
[B]Private Sub fmContactType_LoadData()[/B]
Call fmContactType_LoadData_Clear
If fmContactType_CheckBox_IncludeInactive.Value <> True Then 'get any records that are not inactive
' Exclude Inactive Contact Types
With loContactType
.Sort.SortFields.Add Key:=Range("tblContactType[sStatus]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("tblContactType[sName]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("tblContactType[lContactTypeID]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.Header = xlYes
.MatchCase = False
.Apply
End With
With .Range
.AutoFilter Field:=col_sStatus, Criteria1:="<>" & sInactive 'hide inactive Contact Type
End With
[COLOR=#008000] row_ContactType = .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count - 1 'Do not count the header[/COLOR]
End With
[COLOR=#008000] If row_ContactType < 1 Then 'no active records found, swtich to show inactive
vAnswer = MyMsgBox("No active customer types found." & vbCrLf & _
"Checking for inactive customer types.", _
vbCritical + vbOKOnly, sTitle)
fmContactType_CheckBox_IncludeInactive.Value = True
Call fmContactType_LoadData_Clear
End If[/COLOR]
End If
If fmContactType_CheckBox_IncludeInactive.Value = True Then 'get all records including inactive
' Incude Inactive Contact Types
With loContactType
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("tblContactType[sName]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("tblContactType[lContactTypeID]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.Header = xlYes
.MatchCase = False
.Apply
End With
[COLOR=#ff0000]row_ContactType = .Range.Rows.Count - 1 'Do not count the header[/COLOR]
End With
If row_ContactType < 1 Then 'no records selected, add a new one [B][COLOR=#ff0000]<<<< NEVER TRUE[/COLOR][/B]
vAnswer = MyMsgBox("No customer types found." & vbCrLf & _
"Attempting to add a new customer type record.", _
vbCritical + vbOKOnly, sTitle)
Call fmContactType_CommandButton_New_Click
End If
End If
[COLOR=#0000ff]' Test for empty table
Set RangeFound = loContactType.DataBodyRange
If RangeFound Is Nothing Then
row_ContactType = 1
lContactTypeID = 1
With loContactType
.ListRows.Add Position:=row_ContactType, AlwaysInsert:=True
With .DataBodyRange(row_ContactType)
.Columns(col_lContactTypeID).Value = lContactTypeID
.Columns(col_sStatus).Value = sActive
.Columns(col_dtUpdated).Value = vbNullString
.Columns(col_sName).Value = "New Record " & lContactTypeID
.Columns(col_sDescription).Value = vbNullString
End With
End With
End If[/COLOR]
' Load the array from the filtered and sorted table
vContactTypeBody = loContactType.DataBodyRange.SpecialCells(xlCellTypeVisible)
End Sub
[B]Private Sub fmContactType_LoadData_Clear()[/B]
Dim iCol As Integer
On Error Resume Next 'continue if no filters found
loContactType.AutoFilter.ShowAllData 'clear any existing filters
loContactType.Sort.SortFields.Clear 'clear any existing sorts
For iCol = LBound(vContactTypeBody, 2) To UBound(vContactTypeBody, 2)
loContactType.Range.AutoFilter Field:=iCol, VisibleDropDown:=False 'hide filters
Next iCol
End Sub
