how to tell if a table exists in a worksheet

how can i tell if a table (there will be only 1 per sheet) exists in a worksheet.

i have tried the following:

if activesheet.listobjects(1) = True then

and

if activesheet.listobjects(1) <> "" then

how can i get this to work?

What do you want to do if it does?
Maybe:

Sub dmcgovzzzz()
Dim i As Long
For i = 1 To Sheets.Count
If Sheets(i).ListObjects.Count > 0 Then MsgBox Sheets(i) & "Contains a Table"
Next
End Sub

so i used what you said and did the following:

                Set ws = Sheets("Purchase Requisitions")
                MsgBox ws.ListObjects(1).Count
                If ws.ListObjects(1).Count = 0 Then
                    Application.Run "MakeTableWithTotalRow"
                End If
                Target.ClearContents

but the message box never appears, the target.clear doesn't do it and finally it doesn't make the table. what am i doing wrong?

to answer your question, if there is a table, do nothing. if there is no table, then create one and give a total row.

i also tried the following:

                Set ws = Sheets("Purchase Requisitions")
                Set listobj = ws.ListObjects(1)
                On Error GoTo 0
                
                'MsgBox ws.ListObjects(1).Count
                If listobj Is Nothing Then
                    Application.Run "MakeTableWithTotalRow"
                End If
                Target.ClearContents

Where is your code? Is it Sheet Code? Where does Target.ClearContents come from? Can you post the entire code?

xlnitwit. yup i see that now. :-(

john, here is the entire sheet code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim AWorksheet As Worksheet, ws As Worksheet
    Dim KeyCells As Range, Sendrng As Range, rng As Range
    Dim subject As String, NewString As String, SelectedRow As String, ApprovedReq As String
    Dim NewPO As String, NewPOCell As String, FullExcelPath As String
    Dim xyz As Long, LastRow As Long
    Dim tbl As ListObject
    Dim listobj As ListObject
    
    
    FullExcelPath = ThisWorkbook.FullName
    'MsgBox FullExcelPath
    
    Application.DisplayAlerts = False
    
    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("k:k")
    'below is used if there are multiple ranges to work on
    'Set KeyCells = Range("J:J,A:A,Z:Z")
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

        ' Display a message when one of the designated cells has been changed to "Approved".
        'If Range(Target.Address) = "Approved" Then
        Select Case Target.Text
            Case "Outstanding"
                MsgBox "Outstanding"
            
                Target.ClearContents
            Case "AddRow"
                Application.Run "AddVendorRowsTable"
                Target.ClearContents
            Case "UpdateNotes"
            'this doesnt work yet.
                'MsgBox "UpdateNotes"
                Set ws = Sheets("Purchase Requisitions")
                'On Error Resume Next
                'If Not ws.ListObjects(1) = "" Then
                    Set tbl = ws.ListObjects(1)
                    xyz2 = InputBox("What are the new Notes? ", "UpdateNotes", tbl.ListRows.Item(1).Range.Cells(1, 7).Value)
                    tbl.ListRows.Item(1).Range.Cells(1, 9).Value = xyz2
                    'MsgBox xyz
                    Target.ClearContents
                'End If
            Case "Make Table"
                Set ws = Sheets("Purchase Requisitions")
                Set listobj = ws.ListObjects(1)
                On Error GoTo 0
                
                'MsgBox ws.ListObjects(1).Count
                If ws.ListObjects.Count = 0 Then
                    Application.Run "MakeTableWithTotalRow"
                End If
                Target.ClearContents
            Case Else
                'this should never run as there is data validation on the cells
                'actually this runs if the Action is a blank cell
                If Not Target.Text = Null Then MsgBox Target.Text
                On Error Resume Next
                'MsgBox "Case Else"
                
            End Select
    End If
    Application.DisplayAlerts = True
    
End Sub

the case statement "Make Table" is the code that i am looking for. does this help?

i tried that and nothing happened. i verified that there is no table on the sheet. i would like to upload a sample workbook but have to get rid of all the data. give me a minute to do that.

Maybe?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim AWorksheet As Worksheet, ws As Worksheet
    Dim KeyCells As Range, Sendrng As Range, rng As Range
    Dim subject As String, NewString As String, SelectedRow As String, ApprovedReq As String
    Dim NewPO As String, NewPOCell As String, FullExcelPath As String
    Dim xyz As Long, LastRow As Long
    Dim tbl As ListObject
    Dim listobj As ListObject
    
    
    FullExcelPath = ThisWorkbook.FullName
    'MsgBox FullExcelPath
    
    Application.DisplayAlerts = False
    Set ws = Sheets("Purchase Requisitions")
    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("k:k")
    'below is used if there are multiple ranges to work on
    'Set KeyCells = Range("J:J,A:A,Z:Z")
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

        ' Display a message when one of the designated cells has been changed to "Approved".
        'If Range(Target.Address) = "Approved" Then
        Select Case Target.Text
            Case "Outstanding"
                MsgBox "Outstanding"
            
                Target.ClearContents
            Case "AddRow"
                Application.Run "AddVendorRowsTable"
                Target.ClearContents
            Case "UpdateNotes"
            'this doesnt work yet.
                'MsgBox "UpdateNotes"
                'On Error Resume Next
                'If Not ws.ListObjects(1) = "" Then
                If ws.ListObjects.Count > 0 Then GoTo zz
                    Set tbl = ws.ListObjects(1)
                    xyz2 = InputBox("What are the new Notes? ", "UpdateNotes", tbl.ListRows.Item(1).Range.Cells(1, 7).Value)
                    tbl.ListRows.Item(1).Range.Cells(1, 9).Value = xyz2
                    'MsgBox xyz
                    Target.ClearContents
                'End If
            Case "Make Table"
                If ws.ListObjects.Count > 0 Then GoTo zz
                Set listobj = ws.ListObjects(1)
                On Error GoTo 0
                
                'MsgBox ws.ListObjects(1).Count

                    Application.Run "MakeTableWithTotalRow"
                Target.ClearContents
            Case Else
                'this should never run as there is data validation on the cells
                'actually this runs if the Action is a blank cell
                If Not Target.Text = Null Then MsgBox Target.Text
                On Error Resume Next
                'MsgBox "Case Else"
                
            End Select
    End If
zz:
    Application.DisplayAlerts = True

End Sub

john, i tried that and it appears to do nothing.

xlnitwit, here is the code for maketablewithtotalrow but now i can see that it needs to be fixed. i originally created a table called prtable. this worked when it was just a macro and not fired from row k as an action. so i am sure this needs to be recoded.

Sub MakeTableWithTotalRow()
'
' Macro1 Macro
'
'ActiveSheet.ListObjects("Table3").Delete
'
    With Sheets("Purchase Requisitions")
    Range("A1").Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$G$16"), , xlYes).Name = _
        "PRTable"
    'Range("A13").Select
    ActiveSheet.ListObjects("PRTable").ShowTotals = True
    Range("PRTable[[#Totals],[Amount]]").Select
    ActiveSheet.ListObjects("PRTable").ListColumns("Amount").TotalsCalculation = _
        xlTotalsCalculationSum
    ActiveSheet.ListObjects("PRTable").TableStyle = "TableStyleLight21"
    End With
End Sub

im going to recode for just a messagebox to see if the action is working as expected.

so made some progress with your help.

john, made clerical error (i so hate spaces), now routine is working as you wrote it.

xlnitwit,

thanks for that code. made a few changes and it looks like this:

Sub MakeTableWithTotalRow()
Dim LO As ListObject

    With Sheets("Purchase Requisitions")
        .UsedRange
        LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
       Set LO = .ListObjects.Add(xlSrcRange, .Range("$A$1:$G$" & LastRow), , xlYes)
    End With
    With LO
       .Name = "PRTable"
       .ShowTotals = True
       .ListColumns("Amount").TotalsCalculation = xlTotalsCalculationSum
       .TableStyle = "TableStyleLight21"
    End With
End Sub

wanted to account for dynamic data (not a fixed row) so lastrow does that. so that helps to make this action work as expected.

thanks to both of you.

You're welcome. Glad I could contribute, and thanks for the feedback and reps.

so im working on the update notes case. got the if statement working for either table or range. but i need help with the range part. tried to do offset, but couldn't make the syntax correct. what am i doing wrong?

Case "UpdateNotes"
            'this doesnt work yet.
                'MsgBox "UpdateNotes"
                Set ws = Sheets("Purchase Requisitions")
                'On Error Resume Next
                'If Not ws.ListObjects(1) = "" Then
                If ws.ListObjects.Count > 0 Then
                    Set tbl = ws.ListObjects(1)
                    xyz2 = InputBox("What are the new Notes? ", "UpdateTableNotes", tbl.ListRows.Item(1).Range.Cells(1, 7).Value)
                    tbl.ListRows.Item(1).Range.Cells(1, 7).Value = xyz2
                    'MsgBox xyz
                    Target.ClearContents
                Else
                    'MsgBox Target.Address
                    'rng3 = Range(Target.Offset(0, -4)).Value
                    'MsgBox rng3
                    rng2 = Range(Target.Address).Text
                    'MsgBox "Not a Table"
                    xyz2 = InputBox("What are the new Notes? ", "UpdateRangeNotes", rng2)
                    rng2 = xyz2
                    'Taget.ClearContents 'dont do this till the else works as expected
                'End If
                End If

so the target.address correctly identifies the changed cell(col K), but the field i want to update is in column G so that is why i tried the offset that i did.

any help is appreciated.

thanks xlnitwit, that worked.

i also found this to work as well

NotesRng = Cells(Target.Row, 7).Value

There is a Workbook Sheet Change Event which is appied to every sheet if that's what you're looking for?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim KeyCells As Range

 Dim FullExcelPath As String

 FullExcelPath = ThisWorkbook.FullName
 'MsgBox FullExcelPath

 Application.DisplayAlerts = False

 ' The variable KeyCells contains the cells that will
 ' cause an alert when they are changed.
 Set KeyCells = Range("d:d")

 If Not Application.Intersect(KeyCells, Range(Target.Address)) _
 Is Nothing Then
 Select Case Target.Value
 Case Is < Now - 30
 MsgBox "Move to Closed PO archive file"
 Case Is >= Now - 30
 MsgBox "Keep for now"
 Case Else
 MsgBox "Case Else"
 End Select
 End If
End Sub

Or if you're looking too activate the sheet on Workbooks Open Event then:

Private Sub Workbook_Open()
Sheets("Purchase Requisitions").Activate
End Sub

John,

Neither work as I expect. The first didnt work as expected, and the second error'ed out with a "run time error - 1004, Activate method of worksheet class failed" code. Let me explain what i am looking for.

i have a worksheet change event that fires on the "Closed POs" sheet. the keycell is column D. and it works as expected, when i change a date, i get a messagebox. which is what i want for this stub. So lets say that i put a date in D2 that is 7/25/17 which is one day less than the 30 (in my code) so the message box says to "Keep for Now". Then I save the file. When I return to the file the next day and open it, i want the workbook open event to check all the cells in column d to see if they need to get moved to the closed archived file or just leave it alone (and give me a messagebox).

How can that be done?

so i realize that the code will have to be completely overhauled. cant use intersect cause the date might already be old without changing the value on the sheet. the code would have to look at just the "Closed POs" sheet, examine each cell in the target.range and then do a messagebox. how can i do that?

so this last question doesn't go with the OP, so im going to close this and open up a new case.

thanks to everyone for their help.