I have several tables in an excel sheet. Each having unique table Name. I want to know if a table which has a name "Table123" exist or not in the current sheet.
Could some one help me on this?
Thanks
Jeevan
TableExists = False
On Error GoTo Skip
If ActiveSheet.ListObjects("Table123").Name = "Table123" Then TableExists = True
Skip:
On Error GoTo 0
This code will work and avoid loops and errors
Here is an alternative function:
Function TableExistsOnSheet(ws As Worksheet, sTableName As String) As Boolean
TableExistsOnSheet = ws.Evaluate("ISREF(" & sTableName & ")")
End Function
You can list shape collection and compare names like this
Sub callTableExists()
MsgBox tableExists("Table1", "Shapes")
End Sub
Function TableExists(tableName As String, sheetName As String) As Boolean
Dim targetSheet As Worksheet
Set targetSheet = Worksheets(sheetName)
Dim tbl As ListObject
With targetSheet
For Each tbl In .ListObjects
If tbl.Name = tableName Then TableExists = True
Next tbl
End With
End Function
Another option, using a bit lazy approach with error catching:
Public Sub TestMe()
If TableExists("Table1243", ActiveSheet) Then
MsgBox "Table Exists"
Else
MsgBox "Nope!"
End If
End Sub
Public Function TableExists(tableName As String, ws As Worksheet) As Boolean
On Error GoTo TableExists_Error
If ws.ListObjects(tableName).Name = vbNullString Then
End If
TableExists = True
On Error GoTo 0
Exit Function
TableExists_Error:
TableExists = False
End Function
Try this, use err to get data table status information
also, consider testing the data table on an inactive sheet.
Sub Test_TableNameExists()
TableNm = "Table00"
MsgOutput = TableNm & vbTab & TableNameExists(TableNm)
End Sub
Private Function TableNameExists(nname) As Boolean '#Table #Exist
'Returns TRUE if the data table name exists
'Can test table on inactive sheet
Dim x As Object
On Error Resume Next
'use Range(nname).Parent to get data table sheet name.
'So the function can test data table on inactive sheet.
Set x = Range(nname).Parent.ListObjects(nname)
If Err = 0 Then TableNameExists = True _
Else TableNameExists = False
End Function
Without the use of GoTo, which is a lot more powerfull than appropriate.
Set TableExists = False
On Error Resume Next
If ActiveSheet.ListObjects("Table123").Name = "Table123" Then Set TableExists = True
Be aware that this applies to a single line, thus requiring the line continuation symbol _ to keep larger statements readable.
Related
I'm trying to use an if-condition regarding filters. I wish I could write a code to check if a specific filter is applied and then do something... (of course)
My first attempt was:
If ActiveSheet.Range("$D$4:$Q$20").AutoFilter Field:=2 then
Rows("22:22").Select
Selection.EntireRow.Hidden = True
End If
In the very first line, VBA doesn't accept the condition that is written...
Any guess?
tks
This will tell you if a range is in a filter and the filter is active:
Public Function IsFilterOn(rng As Range) As Boolean
Dim ws As Worksheet
Dim iFilterNum As Integer
Set ws = rng.Parent
If Not ws.AutoFilter Is Nothing Then
If Not Application.Intersect(rng, ws.AutoFilter.Range) Is Nothing Then
With ws.AutoFilter.Filters
iFilterNum = rng.Column - .Item(1).Parent.Range.Column + 1
If iFilterNum <= .Count Then
IsFilterOn = .Item(iFilterNum).On
Exit Function
End If
End With
End If
End If
End Function
Note that you don't need to select a row before hiding it.
Sub HideWhenFiltered()
With ActiveSheet
If .AutoFilterMode Then
If .AutoFilter.Filters(2).On Then
.Rows(22).Hidden = True
End If
End If
End With
End Sub
I have an If/Then loop in VBA that checks if the same cell in each tab are equal, and I can create a string that works in the If/Then loop given a known number of tabs (3 tabs); however, the macro needs to look at an arbitrary number of tabs and I need a dynamic If/Then statement. I tried to create a string that essentially writes the code based on the number of tabs, but I get Type Mismatch because the string is a variable.
For example, this works given 3 tabs:
If Worksheets(loc(1)).Cells(TseriesLine, 15) = Worksheets(loc(2)).Cells(TseriesLine, 15) _
And Worksheets(loc(1)).Cells(TseriesLine, 15) = Worksheets(loc(3)).Cells(TseriesLine, 15) Then
....
But this doesn't work:
ifline = "Worksheets(loc(1)).Cells(TseriesLine, 15) = Worksheets(loc(2)).Cells(TseriesLine, 15) _
And Worksheets(loc(1)).Cells(TseriesLine, 15) = Worksheets(loc(3)).Cells(TseriesLine, 15)"
If ifline Then ....
I also tried using Evalulate(ifline) and StrConv(ifline) to no success. Any help would be appreciated.
Thanks
Try something like this.
You can easily test against other sheet names if there are sheets you know you don't want to check against.
Dim sValue As String
Dim ws1 As Worksheet
Set ws1 = Worksheets("loc(1)")
sValue = ws1.Cells(TseriesLine, 15).Value2
Dim bifline As Boolean
bifline = True
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> ws1.Name Then
If sValue <> ws.Cells(TseriesLine, 15).Value2 Then
bifline = False
Exit For
End
End If
Next
If bifline Then
'more code
End If
You can loop over each sheet with the worksheet collection in each workbook object.
Function doesRangeMatch(rangeAddress As String) As Boolean
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ThisWorkbook.Worksheets(1).Range(rangeAddress).Value <> ws.Range(rangeAddress).Value Then
doesRangeMatch = False
Exit Function 'early exit if match not found
End If
Next
doesRangeMatch = True 'if loop goes through then all must match
End Function
Thanks everyone so much! I used a combination of suggestions to come up with the loop. Here is the solution:
For ss = 2 To numloc
If Worksheets(loc(1)).Cells(TseriesLine, 15) <> Worksheets(loc(ss)).Cells(TseriesLine, 15) Then
doNumMatch = False
Exit For
Else: doNumMatch = True
End If
Next
If doNumMatch Then
I want to test if a range exists to be able to create the following pattern:
if not exists(r) then
MsgBox("Range is missing")
end if
Function exists(r as range) as boolean
End function
Here is an example of a range that I would like to test if it exists or not
Call RangeExists(lob.ListColumns("Leverera utt").DataBodyRange)
How can I do this?
You could do it this way:
Sub CheckRange()
Dim myRange As Variant
myRange = InputBox("Enter your name of your range")
If RangeExists(CStr(myRange)) Then
MsgBox "True"
Else
MsgBox "No"
End If
End Sub
And the function:
Function RangeExists(s As String) As Boolean
On Error GoTo No
RangeExists = Range(s).Count > 0
No:
End Function
Avoiding the label required in ON ERROR GOTO is also possible
Function RangeExists(rngName As String) As Boolean
On Error Resume Next
RangeExists = Range(rngName).Column And (Err.Number = 0)
Debug.Print "RangeExists= " & RangeExists & " " & rngName
End Function
I'm trying to set up a couple simple buttons to filter multiple pivots on multiple sheets within a workbook. Nothing fancy here! The pivots do not share a common source, so slicers won't work for me. But all share a common field name that I want to filter.
My code works if I step through it (F8) but if I try to run it straight through (F5) I get an error of "Code execution has been interrupted" and the debugger highlights the first Next. If I comment out the line which modifies the filter, the function runs fine regardless of which way I do it. Help please?
Sub troubleshoot()
Dim wks As Worksheet, strName As String, pvt As PivotTable, strPvtName As String
For Each wks In Worksheets
strName = wks.Name
For Each pvt In wks.PivotTables
strPvtName = pvt.Name
Debug.Print strName + " / " + strPvtName
Sheets(strName).PivotTables(strPvtName).PivotFields("OrderSubType").ClearAllFilters
Next
Next
Set wks = Nothing
Set pvt = Nothing
End Sub
Here is a way to go through all pivot table and clear all filters on "OrderSubType" field (When this field exists) using 2 FOR LOOP. I Also have put some error handling.
Public Sub troubleshoot()
Application.ScreenUpdating = False
On Error GoTo EndOfSub
Dim wks As Worksheet, pvt As PivotTable, pvts As PivotTables
Dim i As Integer, j As Integer
For i = 1 To ThisWorkbook.Sheets.Count
Set wks = ThisWorkbook.Sheets(i)
Set pvts = wks.PivotTables 'GET PIVOTTABLES COLLECTION
For j = 1 To pvts.Count
Set pvt = pvts(j)
Debug.Print wks.Name + " / " + pvt.Name
If PivotContainsField(pvt, "OrderSubType") Then
pvt.PivotFields("OrderSubType").ClearAllFilters 'CLEAR FILTERS
Else
Debug.Print "OrderSubType field not found in : " + pvt.Name
End If
Next j
Next i
Set wks = Nothing
Set pvt = Nothing
EndOfSub:
Application.ScreenUpdating = True
If Err.Number <> 0 Then
MsgBox "Error : " & Err.Description
End If
End Sub
Public Function PivotContainsField(pvt As PivotTable, fieldName As String) As Boolean
On Error Resume Next
pvt.PivotFields (fieldName)
PivotContainsField = (Err.Number = 0)
On Error GoTo 0
End Function
This is my code:
Private Sub New_User_Create_Click()
CreateUsername_L = LCase(Create_User_Text.Text)
For Each ws In Worksheets
If (Worksheets(CreateUsername_L).Name <> "") Then
MsgBox "Username is already taken! Try again!"
Create_User_Text.Text = ""
NewUser.Hide
Exit For
Else
Dim work As Worksheet
With ThisWorkbook
Set worksheetname = .Sheets.Add(After:=Worksheets(Worksheets.Count))
worksheetname.Name = CreateUsername_L
On Error Resume Next
Create_User_Text.Text = ""
NewUser.Hide
[B1].Value = (UserName + "'s Personal Profile")
Exit For
End With
End If
Next ws
End Sub
If you could help me with this it would be much appreciated
(also the error only occurs when the condition is not met e.g there is no sheet with the same name as "CreateUsername_L". When the condition is met the message box with "Username is already taken..." shows up so its only when the condition is not met when this error occurs)
You can't test for the existance of the worksheet name like you're trying to do. The 'Subscript out of range' error is looking for that worksheet name and if it can't find it then you get your error. You can write a function to test for the existence of a name and use that instead. Here's mine:
Public Function doesSheetNameExist(inputName As String) As Boolean
Dim ws As Worksheet
On Error GoTo ErrorCatch
Set ws = Thisworkbook.Worksheets(inputName)
'if no error here then worksheet exists
doesSheetNameExist= True
CloseFunction:
Exit Function
ErrorCatch:
doesSheetNameExist= False
Resume CloseFunction
End Function
This handles the error within the function. Alternatively you could loop through each worksheet and test the name.
You'd then replace your line
If (Worksheets(CreateUsername_L).Name <> "") Then
with
If doesSheetNameExist(CreateUsername_L) Then