Check if named tables exist VBA Excel 2007 - vba

I am trying to determine if a table exists, using VBA Excel 2007, and if it exists then delete it.
I am looping through an array of table names.
My code is below:
' Allocate
Dim lIndex As Long
' Allocate table header values in array
Dim sTableNames(1 To Constants.lNumTables) As String
' Populate array
sTableNames(1) = Constants.sTableNameKpiAllIncidents
sTableNames(2) = Constants.sTableNameSlaAllManualHelpdeskIncidents
sTableNames(3) = Constants.sTableNameSlaAllManualIncidents
sTableNames(4) = Constants.sTableNameKpiAllAutomaticIncidents
' Work in worksheet Statistics
With Worksheets(Constants.sSheetNameStatistics)
' Loop through all tables
For lIndex = 1 To UBound(sTableNames)
' Check if table already exists
If Not .ListObjects(sTableNames(lIndex)) Is Nothing Then
' Delete table
.ListObjects(sTableNames(lIndex)).Delete
End If
Next
End With
My code works as long as these tables exist in my worksheet. I have also tried replacing the line
If Not .ListObjects(sTableNames(lIndex)) Is Nothing Then
with the line
If .ListObjects(sTableNames(lIndex)).Count > 0 Then
but it still doesn't work.
Does anybody know a way to get this to work?
Any help would be appreciated.

Error handling as nhee suggests is the right approach.
As a UDF the suggestion above would be quicker with:
Function TableExists(ws As Worksheet, tblNam As String) As Boolean
Dim oTbl As ListObject
On Error Resume Next
Set oTbl = ws.ListObjects(tblNam)
TableExists = Not oTbl Is Nothing
End Function

The following UDF will return a boolean if a table exists
Function TableExists(ws As Worksheet, tblNam As String) As Boolean
Dim oTbl As ListObject
For Each oTbl In ws.ListObjects
If oTbl.Name = tblNam Then
TableExists = True
Exit Function
End If
Next oTbl
TableExists = False
End Function

Related

# VALUE Error while executing UDF VBA Function on formatted cells

I wrote the following function to check if the prerequisites for my Excel row are satisified.
Public Function PREREQUISITESOK(prerequisites As Range) As String
Dim cw As Worksheet
Dim prerequisite_cell As Range
Dim prerequisite_cell_txt As String
Dim training_id_cell As Range
Dim no_groups_cell_to_compare As Range
Dim no_groups_cell_to_check As Range
Dim training_id_cell_txt As String
Dim training_id_cell_row_n As Integer
Dim n As Integer
Application.Volatile
PREREQUISITESOK = "OK"
Set cw = Sheets("4c.Trainings OSS")
Set training_id = cw.Range("$B$11:$B$34")
Set no_groups_cell_to_compare = cw.Range("J" & CStr(prerequisites.Row))
For Each prerequisite_cell In prerequisites.Cells
prerequisite_cell_txt = prerequisite_cell.Text
If prerequisite_cell_txt = "" Then
Exit For
Else
For Each training_id_cell In training_id.Cells
training_id_cell_txt = training_id_cell.Text
If training_id_cell_txt = prerequisite_cell_txt Then
training_id_cell_row_n = training_id_cell.Row
Set no_groups_cell_to_check = cw.Cells(training_id_cell_row_n, no_groups_cell_to_compare.Column)
If no_groups_cell_to_check.Value < no_groups_cell_to_compare.Value Then
PREREQUISITESOK = "NOT OK"
Exit Function 'It is enough for us that one prerequisite is not satisfied so we can exit the function
Else
PREREQUISITESOK = "OK"
End If
Exit For 'Training IDs are unique so if we find the right Training ID then we may exit the loop
End If
Next training_id_cell
End If
Next prerequisite_cell
End Function
Note that the prerequisites range is inline formatted.
The function that I wrote is supposed to return String value so I completely do not understand why am I getting #VALUE! error.
What is interesting that if I clear formatting from the prerequisites cells that are used as arguments of the function then #VALUE! error disappears.
Do you have any idea why this happens?

Vary the size of an excel table based of the size of another table

I'm trying to create a Macro that will take in data on one sheet of my workbook, and create a set of output data on another sheet. I have two tables, Input_Data (on the Data sheet) and Output_Data (on the DI) sheet.
Public Sub resize()
Dim inputTable As ListObject
Dim outputTable As ListObject
Dim sizeInput As Long
Dim sizeOutput As Long
Set inputTable = Sheets("Data").ListObjects("Input_Data")
Set ouputTable = Sheets("DI").ListObjects("Output_Data")
sizeInput = inputTable.Range.Rows.Count
sizeOutput = outputTable.Range.Rows.Count
Do While sizeInput > sizeOutput
ouputTable.ListRows.Add
Loop
End Sub
Above is what I have so far from looking at other posts. When I try to run it I get a runtime error '91': "Object variable or With block variable not set. I'm guessing I'm referencing things wrong somewhere, but I'm not sure where. I would also like this to run continuously, or at least run when data is added to the Input_Data column, or trigger when people switch from the Data sheet to another. Not really sure what would cause the least amount of lag. I currently have this code in the "ThisWorkbook" object, not sure if that's the right place.
Any advice or help is greatly appreciated.
ListObject.Resize Method
Try this:
Option Explicit
Sub ResizeList()
Dim table1 As ListObject
Dim table2 As ListObject
Set table1 = ThisWorkbook.Sheets("Sheet1").ListObjects("Table1")
Set table2 = ThisWorkbook.Sheets("Sheet2").ListObjects("Table2")
Dim rows_count As Long
Dim columns_count As Long
Dim x As String
Dim y As String
With table2
rows_count = .Range.Rows.Count
columns_count = .Range.Columns.Count
End With
With table1
x = .Range.Cells(1, 1).Address
y = .Range.Cells(rows_count, columns_count).Address
.Resize Range(x & ":" & y)
End With
End Sub

Excel VBA constant arrays to vba code array

I'm working on excel VBA school assignment and I have an issue and can't seem to find answer online.
I have database table that holds information, in certain location I have constant array of ={false, true, false} and I need it to convert it to VBA array TF(1 to 3)
TF(1) should have value of false
TF(2) should have value of true
TF(3) should have value of false
so far my code looks like this:
Sub trying()
Dim TF(1 To 3) As String
Set targetWorksheet = Worksheets("duomBazeSheet")
Worksheets("duomBazeSheet").Activate
With targetWorksheet
TF(1) = .Cells(2, 8).Value
MsgBox (TF(1))
End With
End Sub
"duomBazeSheet" is a sheet that has all data in it and target location is (2, 8)
any ideas?
edit: here's link how sheet looks : array is highlighted https://imgur.com/a/lII3c
Based on a feature called Evaluate one can do this
Dim tf
tf = Application.Evaluate("{True,False,True}")
Given the formula text in H2 try this ...
Sub Test()
Dim tf
tf = Application.Evaluate(ActiveSheet.Cells(2, 8).Formula)
Dim i
For i = LBound(tf) To UBound(tf)
MsgBox tf(i)
Next i
End Sub
The following code declares and populates a one-dimensional array with the values false, true, false. The For Loop will display each element at the end. It is unclear where you want to place these values.
Sub trying()
Dim TF As Variant
Dim i As Long
Dim targetWorksheet As Worksheet
Set targetWorksheet = Worksheets("duomBazeSheet")
With targetWorksheet
TF = Split(.Cells(2, 8).Value, Chr$(10)) 'Chr$(10) is a carriage return
End With
For i = LBound(TF) To UBound(TF)
MsgBox TF(i)
Next i
End Sub

Excel VBA - Dynamically supply ranges to Union method

User has defined named ranges to print in Excel.
I am reading these ranges into a VBA array. Is there a way to supply the range names to the Union method to set non-contiguous print ranges.
For example, something like:
ActiveSheet.PageSetup.PrintArea = Union(Range(array(1)), Range(array(2))).Address
The number of ranges held in the array can vary. I've experimented with looping through the array and building a string variable, but no success.
Any help would be appreciated.
You'll have to substitute the actual range names or objects in the statement, but here is how to use the Union function to set a PrintArea:
Sub foo()
Dim setup As PageSetup
Set setup = ActiveSheet.PageSetup
setup.PrintArea = Union(Range("MyRange1"), Range("MyRange2")).Address
End Sub
What I'm actually looking for is a method to construct the Union statement using range names that are held in an array
OK, then use the above method and a custom function to construct the Union in a loop:
Sub foo()
Dim setup As PageSetup
Dim RangeArray(1) As Range
Set setup = ActiveSheet.PageSetup
Set RangeArray(0) = Range("MyRange1")
Set RangeArray(1) = Range("MyRange2")
setup.PrintArea = GetUnion(RangeArray)
End Sub
Function GetUnion(arr As Variant) As String
Dim itm As Variant
Dim ret As Range
For Each itm In arr
If Not ret Is Nothing Then
Set ret = Union(ret, itm)
Else
Set ret = itm
End If
Next
If Not ret Is Nothing Then
GetUnion = ret.Address
Else
GetUnion = "" 'May cause an error...
End If
End Function

VBA on click_ delete records of a table

I am trying to delete the records of a table rather than deleting the records of a form. I have the following code, which does not work:
please can someone help.
Private Sub Cmd_X_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsCount As Integer
Dim BizNO As Field
Dim Bank_Role As Field
Dim i, j As Integer
Set db = CurrentDb()
Set rs_date = db.OpenRecordset("TRD_Pricing-In date_REAL")
Set PE_ID = rs_date.Fields("Pricing_Element_ID")
rs_date.MoveLast
rs_dateCount = rs_date.RecordCount
MsgBox (rs_dateCount)
MsgBox (Me.Pricing_Element_ID)
MsgBox (PE_ID.Value)
rs_date.MoveLast
For i = 1 To rs_dateCount
If Me!Pricing_Element_ID = PE_ID Then
rs_date.DELETE
Else
rs_date.MovePrevious
End If
Next i
End Sub
In your for loop you are not comparing the right elements. When you do:
Set PE_ID = rs_date.Fields("Pricing_Element_ID")
you set PE_ID to the value of the Pricing_Element_ID of the first record. You intend to set a reference to it, and everytime the recordset advances to the next record, you want this reference to be updated. But that's not how it works. You have to get the field in the current record every time you advance the recordset. So you have to write:
If Me!Pricing_Element_ID = rs_date.Fields("Pricing_Element_ID") Then
Note: from experience I found the count of a recordset is not always accurate. So rather than a for loop, use a while loop:
While (Not EOF(rs_date))
If Me!Pricing_Element_ID = rs_date.Fields("Pricing_Element_ID") Then
rs_date.DELETE
Else
rs_date.MoveNext
End If
Wend
Note also that there is no need to proces the recordset from last to first; just advance to next until EOF.