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
Related
Let's say i have this value "ABC123" in Sheet1.Range("A1")
I want to search for/ match this value in Sheet2.Range("A1:A10") // or the column
If the value is found
//msgbox "Found"
else
//msgbox "Not found"
end if
try this:
Sub foo()
Dim t As Long
On Error Resume Next
t = Application.WorksheetFunction.Match(Worksheets("Sheet1").Range("A1"), Worksheets("Sheet2").Range("A:A"), 0)
On Error GoTo 0
If t > 0 Then
MsgBox "Found"
Else
MsgBox "Not found"
End If
End Sub
Try using the Match function below (you will get the row number found):
Option Explicit
Sub MatchTest()
Dim MatchRes As Variant
MatchRes = Application.Match(Worksheets("Sheet1").Range("A1").Value, Worksheets("Sheet2").Range("A1:A10"), 0)
If IsError(MatchRes) Then
MsgBox "Not found"
Else
MsgBox "Found at row " & MatchRes
End If
End Sub
Consider:
Sub dural()
Dim s As String, r1 As Range, r2 As Range, r3 As Range
Set r1 = Sheet1.Range("A1")
Set r2 = Sheet2.Range("A1:A10")
s = r1.Value
Set r3 = r2.Find(what:=s, after:=r2(1))
If r3 Is Nothing Then
MsgBox "not found"
Else
MsgBox "Found"
End If
End Sub
just playing around a little bit with Scott's solution:
Sub foo2()
Dim t As Long
On Error GoTo NotFound
t = Application.WorksheetFunction.Match(Worksheets("Sheet1").Range("A1"), Worksheets("Sheet2").Range("A:A"), 0)
MsgBox "Found
Exit Sub
NotFound:
MsgBox "Not found"
End Sub
Hi I'm pretty new at the vba so please don't shoot my code :-).
I have a set of repaeting code's. I woukld like to simplify this code by using the code name with an increasing number. I can't get it to run. Can someone help me a bit on the road to get this going.
Below what I'm trying.
The second block is a part of the code now (it's 40 blocks of the same code only increasing the number)
Sub sheet41()
Dim i As Integer
Dim chkname As Integer
chkname = "SheetCheckBox" & i
i = 1
Do
i = i + 1
If chkname.Visible = False Then Exit Sub
If chkname.value = True Then
Sheets("Item_" & i).Select
Call Finalize
End If
Loop Until i = ThisWorkbook.Worksheets.Count
End Sub
This is the old code:
Sub Sheet1()
If SheetCheckBox1.Visible = False Then Exit Sub
If SheetCheckBox1.value = True Then
Sheets("Item_1").Select
Call Finalize
End If
End Sub
Sub Sheet2()
If SheetCheckBox2.Visible = False Then Exit Sub
If SheetCheckBox2.value = True Then
Sheets("Item_2").Select
Call Finalize
End If
End Sub
Sub Sheet3()
If SheetCheckBox3.Visible = False Then Exit Sub
If SheetCheckBox3.value = True Then
Sheets("Item_3").Select
Call Finalize
End If
End Sub
As you can see this should be possible to clean I asume.
This should do it. If finalize isn't called on a worksheet then the reason why is printed to the Immediate Window.
Sub ProcessWorkSheets()
Dim check As MSForms.CHECKBOX
Dim i As Integer
For i = 1 To Worksheets.Count
On Error Resume Next
Set check = Worksheets(i).OLEObjects("SheetCheckBox" & i).Object
On Error GoTo 0
If check Is Nothing Then
Debug.Print Worksheets(i).Name; " - Checkbox not found"
Else
If check.Visible And check.Value Then
Worksheets(i).Select
Call Finalize
Else
Debug.Print Worksheets(i).Name; " - Checkbox", "Visible", check.Visible, "Value:", check.Value
End If
End If
Set check = Nothing
Next
End Sub
If the checkboxes on the Sheet are ActiveX Controls, you can use this to access the checkboxes:
Sheets("sheet1").OLEObjects("chkTest").Object
if you want to change the value of a checkbox, use it like this:
Sheets("sheet1").OLEObjects("chkTest").Object.Value = True
now replace "sheet1" with your actual sheet name and change the "chkTest" to your string chkname
So your complete code should be like this:
Dim i As Integer
Dim sheetname As String
Dim chkname As String
sheetname = "YOUR SHEETNAME HERE"
For i = 1 To ThisWorkbook.Worksheets.Count Step 1
chkname = "SheetCheckBox" & i
If Sheets(sheetname).OLEObjects(chkname).Object.Visible = False Then Exit Sub
If Sheets(sheetname).OLEObjects(chkname).Object.Value = True Then
Sheets("Item_" & i).Select
Call Finalize
End If
Next i
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.
In the main subroutine, I have to get two user inputs ((1) range address (e.g., A1:C50), (2) Name String (e.g., James)), and call the function subroutine (by passing the inputs as arguments), and printout the result through Message Box as to whether the name exists or doesn't exist in the range.
Both the search range and the name should be input from the users. How do I write the Function subRoutine and the calling sub? This is what I have so far.
Function NameExists(name As String, area As Range) As Boolean
If name = area.Value Then
NameExists = True
Else
NameExists = False
End If
End Function
Sub Main()
Dim NameExists As Boolean
Dim name As String
name = InputBox("Enter a Name")
area = InputBox("Enter a Range")
If NameExists = True Then
MsgBox name & " Has Been Found"
Else
MsgBox name & " Has Not Been Found"
End If
End Sub
You need to actually call the Function that checks if it exists and pass the name and area variables that you've had the user input. Here is a somewhat crude example:
Sub Main()
Dim nm As String
Dim ar As String
nm = InputBox("Enter a Name")
ar = InputBox("Enter a Range")
If NameExists(nm, ar) = True Then
MsgBox nm & " Has Been Found"
Else
MsgBox nm & " Has Not Been Found"
End If
End Sub
Private Function NameExists(name As String, area As String) As Boolean
Dim myRange As Range
Set myRange = Range(area)
For Each myCell In myRange
If myCell.Value = name Then
NameExists = True
Exit For
End If
Next
Set myRange = Nothing
End Function
I have a VBA function in Excel returns a concatenated string of text from cells selected by users.
This works as I require, however if there are hidden cells in the selection, the value of the hidden cell is included, which is undesirable. An example of when this issue occurs is when a table is filtered.
Is there a way to amend my function to check if the cell that is being read is visible?
Sub ConcatEmialAddresses()
Dim EmailAddresses As String
ActiveSheet.Range("C3").Value = combineSelected()
ActiveSheet.Range("C3").Select
Call MsgBox("The email address string from cell ""C3"" has been copied to your clipboard.", vbOKOnly, "Sit back, relax, it's all been taken care of...")
End Sub
Function combineSelected(Optional ByVal separator As String = "; ", _
Optional ByVal copyText As Boolean = True) As String
Dim cellValue As Range
Dim outputText As String
For Each cellValue In Selection
outputText = outputText & cellValue & separator
Next cellValue
If Right(outputText, 2) = separator Then outputText = Left(outputText, Len(outputText) - 2)
combineSelected = outputText
End Function
To determine if a Range has an hidden cell, I would check that the height/width of each row/column is different from zero:
Function HasHiddenCell(source As Range) As Boolean
Dim rg As Range
'check the columns
If VBA.IsNull(source.ColumnWidth) Then
For Each rg In source.Columns
If rg.ColumnWidth = 0 Then
HasHiddenCell = True
Exit Function
End If
Next
End If
' check the rows
If VBA.IsNull(source.RowHeight) Then
For Each rg In source.rows
If rg.RowHeight = 0 Then
HasHiddenCell = True
Exit Function
End If
Next
End If
End Function
Sub UsageExample()
If HasHiddenCell(selection) Then
Debug.Print "A cell is hidden"
Else
Debug.Print "all cells are visible"
End If
End Sub
I used this
Function areCellsHidden(Target As Range)
areCellsHidden = False
If (Target.Rows.Hidden = True) Then
areCellsHidden = True
ElseIf (Target.Columns.Hidden = True) Then
areCellsHidden = True
ElseIf (Target.Count > 1) Then
If _
Target.Count <> Target.Columns.SpecialCells(xlCellTypeVisible).Count _
Or Target.Count <> Target.Rows.SpecialCells(xlCellTypeVisible).Count _
Then
areCellsHidden = True
End If
End If
End Function