I have to update a Excel file, which contains a Visual Basic routine attached to a button.
I tried to prevent the routine from run with empty data and wanted to do an early return:
Sub FillProductDetail()
Dim wks As Worksheet
set wks = Worksheets("Product Detail")
Dim ProductToShow As String
ProductToShow = wks.Range("C4")
wks.Rows("5:1000")Delete Shift :=xlUp
If ProductToShow = "" Then
Return
End If
..... many lines which take forever if ProductToShow is empty
End Sub
I know how to include the rest of the function in the If statement, that works, but then everything is indented even further to the right. I have seen the Return statement before in Basic.
You should use Exit Sub
in a subroutine
Is this what you mean?
Option Explicit
Sub FillProductDetail()
Dim wks As Worksheet
Set wks = ThisWorkbook.ActiveSheet
Dim ProductToShow As String
ProductToShow = wks.Range("C4")
wks.Rows("5:1000").Delete Shift:=xlUp
If ProductToShow = "" Then GoSub MyRoutine
Exit Sub
MyRoutine:
MsgBox "Empty cell"
Return
End Sub
Related
I am a novice in vba who currently designing some sorts of automated Matrix system in excel. I tried both sets of codes in a Worksheet and it runs perfectly. But,when i try to use the same code in an event sub in an userform, an error 91 popped out and showed an error in orivalue, though I already assign a value to it. Also I will highlight the debug lines according to the compiler.
Here are the codes for the function.
Function find_prevconfig(x2 As Integer) As Range
For y = 0 To 30
If Range("E590").Offset(y, x2) = "Y" Then
Set find_preconfig = Range("C590").Offset(y, 0)
Exit Function
End If
Next y
End Function
And here is the event sub that i called the function to:
Private Sub btn_confirm_Click()
Dim orivalue As Range
Dim i As Integer
For i = 0 To 30
If Range("E26").Offset(0, i).Value = Range("J6").Value Then
Set orivalue = find_prevconfig(i)
MsgBox (orivalue)
End If
Next i
End Sub
The debug line is MsgBox (orivalue) as it said orivalue = nothing. Your help and advices are really much appreciated!
the object variable or With block variable not set" or Error "91"
There are few things that I will address.
1. Regarding the error, you need to check if the object exists before you use it. For example
The line MsgBox (orivalue) should be written as
Set orivalue = find_prevconfig(i)
If Not orivalue Is Nothing Then
MsgBox orivalue.Value
Else
MsgBox "Object is Nothing"
End If
2. Your object find_prevconfig will always be Nothing even if the condition is True. And that is because of a typo. Function name is find_prevconfig but you are using find_preconfig. It is advisable to always use Option Explicit
3. Fully qualify your objects. In your code if you do not do that, then it will refer to the active sheet and the active sheet may not be the sheet that you are expecting it to be. For example ThisWorkbook.Sheets("Sheet1").Range("E590").Offset(y, x2)
4. Even though, .Value is the default property of a range when you are assigning a value or reading a value, it is advisable to use it explicitly. I personally believe it is a good habit. Will help you avoid lot of headaches in the future when you are quickly skimming the code. Set rng = Range("SomeRange") vs SomeValue = Range("SomeRange").Value or SomeValue = Range("SomeRange").Value2
5. When you are doing a string comparison, it is advisable to consider that the strings can have spaces or can be of different case. "y" is not equal to "Y". Similarly, "Y " is not equal to "Y". I, if required, use TRIM and UCASE for this purpose as shown in the code below.
Your code can be written as (UNTESTED)
Option Explicit
Function find_prevconfig(x2 As Long) As Range
Dim y As Long
Dim rng As Range
Dim ws As Worksheet
'~~> Change sheet as applicable
Set ws = ThisWorkbook.Sheets("Sheet1")
For y = 0 To 30
If Trim(UCase(ws.Range("E590").Offset(y, x2).Value2)) = "Y" Then
Set rng = ws.Range("C590").Offset(y)
Exit For
End If
Next y
Set find_prevconfig = rng
End Function
Private Sub btn_confirm_Click()
Dim orivalue As Range
Dim i As Long
Dim ws As Worksheet
'~~> Change sheet as applicable
'~~> You can also pass the worksheet as a parameter if the comparision is
'~~> in the same sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
For i = 0 To 30
If ws.Range("E26").Offset(0, i).Value = ws.Range("J6").Value Then
Set orivalue = find_prevconfig(i)
'~~> Msgbox in a long loop can be very annoying. Use judiciously
If Not orivalue Is Nothing Then
'MsgBox orivalue.Value
Debug.Print orivalue.Value
Else
'MsgBox "Object is Nothing"
Debug.Print "Object is Nothing"
End If
End If
Next i
End Sub
Is there any way to delete named ranges used in chart series when the chart is being deleted?
I use named ranges quite extensively in my daily work, also for charting. When I create charts I often name data ranges and THEN use them for chart series.
I am looking for a way to delete USED named ranges WHEN I delete the chart. I thought about chart "delete" event, but I cannot find any info about it (does it even exist???).
The second issue is how to determine which ranges have been used for chart series? Deleting the named ranges is easy, but how to actually determine, which ranges have been used in chart series?
All help is MUCH appreciated. Apologies but I cannot provide you with any code, as I have no idea how to set things up
Try the next code please. The USED named ranges cannot be extract directly. I used a trick to extract the ranges form SeriesCollection formula. Then compare them with names RefersToRange.Address and delete the matching name. It (now) returns a boolean value in case of match (only to see it in Immediate Window), but not necessary for your purpose. The code also delete the invalid names (having their reference lost).
Edited: I made some researches and I am afraid it is not possible to create a BeforeDelete event... It is an enumeration of events able to be created for a chart object, but this one is missing. I like to believe that I found a solution for your problem, respectively:
Create a class able to enable BeforeRightClick event. Name it CChartClass and write the next code:
Option Explicit
Public WithEvents ChartEvent As Chart
Private Sub ChartEvent_BeforeRightClick(Cancel As Boolean)
Dim msAnswer As VbMsgBoxResult
msAnswer = MsgBox("Do you like to delete the active chart and its involved Named ranges?" & vbCrLf & _
" If yes, please press ""Yes"" button!", vbYesNo, "Chart deletion confirmation")
If msAnswer <> vbYes Then Exit Sub
Debug.Print ActiveChart.Name, ActiveChart.Parent.Name
testDeleteNamesAndChart (ActiveChart.Parent.Name)
End Sub
Create another class able to deal with workbook and worksheet events, name it CAppEvent and copy the next code:
Option Explicit
Public WithEvents EventApp As Excel.Application
Private Sub EventApp_SheetActivate(ByVal Sh As Object)
Set_All_Charts
End Sub
Private Sub EventApp_SheetDeactivate(ByVal Sh As Object)
Reset_All_Charts
End Sub
Private Sub EventApp_WorkbookActivate(ByVal Wb As Workbook)
Set_All_Charts
End Sub
Private Sub EventApp_WorkbookDeactivate(ByVal Wb As Workbook)
Reset_All_Charts
End Sub
Put the next code in a standard module (need to create a classes array in order to start the event for all existing sheet embedded charts):
Option Explicit
Dim clsAppEvent As New CAppEvent
Dim clsChartEvent As New CChartClass
Dim clsChartEvents() As New CChartClass
Sub InitializeAppEvents()
Set clsAppEvent.EventApp = Application
Set_All_Charts
End Sub
Sub TerminateAppEvents()
Set clsAppEvent.EventApp = Nothing
Reset_All_Charts
End Sub
Sub Set_All_Charts()
If ActiveSheet.ChartObjects.Count > 0 Then
ReDim clsChartEvents(1 To ActiveSheet.ChartObjects.Count)
Dim chtObj As ChartObject, chtnum As Long
chtnum = 1
For Each chtObj In ActiveSheet.ChartObjects
Set clsChartEvents(chtnum).ChartEvent = chtObj.Chart
chtnum = chtnum + 1
Next
End If
End Sub
Sub Reset_All_Charts()
' Disable events for all charts
Dim chtnum As Long
On Error Resume Next
Set clsChartEvent.ChartEvent = Nothing
For chtnum = 1 To UBound(clsChartEvents)
Set clsChartEvents(chtnum).ChartEvent = Nothing
Next ' chtnum
On Error GoTo 0
End Sub
Sub testDeleteNamesAndChart(strChName As String)
Dim rng As Range, cht As Chart, sFormula As String
Dim i As Long, j As Long, arrF As Variant, nRng As Range
Set cht = ActiveSheet.ChartObjects(strChName).Chart
For j = 1 To cht.SeriesCollection.Count
sFormula = cht.SeriesCollection(j).Formula: Debug.Print sFormula
arrF = Split(sFormula, ",")
For i = 0 To UBound(arrF) - 1
If i = 0 Then
Set nRng = Range(Split((Split(sFormula, ",")(i)), "(")(1))
Else
Set nRng = Range(Split(sFormula, ",")(i)) '(1)
End If
Debug.Print nRng.Address, matchName(nRng.Address)
Next i
ActiveSheet.ChartObjects(strChName).Delete
End Sub
Private Function matchName(strN As String) As Boolean
Dim Nm As Name, strTemp As String
For Each Nm In ActiveWorkbook.Names
On Error Resume Next
strTemp = Nm.RefersToRange.Address
If Err.Number <> 0 Then
Err.Clear
Nm.Delete
Else
If strN = strTemp Then
Nm.Delete
matchName = True: Exit Function
End If
End If
On Error GoTo 0
Next
End Function
Use the next events code in the ThisWorkbook module:
Option Explicit
Private Sub Workbook_Open()
InitializeAppEvents
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
TerminateAppEvents
End Sub
Please confirm that it worked as you need
I'm trying to do a User Form that allows to insert a number in a ListBox, in case this number matches with one of sheet names, to select this work sheet. In case there is not a match, to give a message box, that the number was not found.
But i have a problem with defining that the ListBox text must be compared with Sheet names.
It looks in a following way:
The code is following:
Private Sub CommandButton1_Click()
Option Explicit
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
'this line i could not manage
If ws.Name Like "Tel*" Then
Sheets("Tabella Riepilogativa").Select
End If
Else: MsgBox "Phone number was not found"
Next
End Sub
Private Sub Label1_Click()
End Sub
Private Sub ListBox1_Click()
End Sub
Can someone help with it, please?
The Option Explicit belongs at the top of the file.
To find a sheet named "Tel{whatever the user entered in a TextBox}":
Private Sub CommandButton1_Click()
Dim ws As Worksheet, wsFound As Worksheet, searchFor As String
searchFor = "TEL" & UCase$(Trim$(TextBox1.Text))
For Each ws In ThisWorkbook.Sheets
If UCase$(ws.Name) = searchFor Then
Set wsFound = ws
Exit For
End If
Next
If wsFound Is Nothing Then
MsgBox "Not Found (I should probably be a label to save the user an unnecessary click)"
Else
wsFound.Select
End If
End Sub
I work with sheets named; Rev00, Rev01, Rev02 etc - among other sheets in my workbook.
It would be very helpful (in order to compare the sub-summaries of different revisions) to set the exact same multiple-filter - as set in active sheet - in only all sheets beginning with "Rev".
This action should most wanted be activated by double Click in Range("A1") or somewhere like that (I dont want button on this one).
If possible next double Click in Range("A1") should reset filters.
Sub Test()
Dim ws As Worksheet, str As String
For Each ws In Worksheets
str = Left(ws.Name, 3)
If str = "Rev" Then
' set filter as in active.sheet
End If
Next ws
End Sub
... and I am stuck ....
will anyone guide me on this?
Yes it is possible. :) Here is a basic sample on how it should work.
Sub Test()
Dim ws As Worksheet, str As String
For Each ws In Worksheets
str = Left(ws.Name, 3)
If UCase(str) = "REV" Then
With ws
'~~> Remove any filters
.AutoFilterMode = False
With <YOUR RANGE>
.AutoFilter Field:=<RELEVANT FIELD>, _
Criteria1:=<YOUR CRITERIA>
'
'~~> Rest of the code
'
End With
'~~> Remove any filters
'.AutoFilterMode = False
End With
End If
Next ws
End Sub
Here you can see Autofilter in action :)
To call the above code by clicking Range A1, you can use the Worksheet_BeforeDoubleClick event.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A1")) Is Nothing Then
'
'~~> Your code goes here
'
Cancel = True
End If
End Sub
Regarding your query about making Range A1 respond as an ON/OFF switch, you can use a boolean variable s shown HERE
I need to assign a unique name to a cell which calls a particular user defined function.
I tried
Dim r As Range
set r = Application.Caller
r.Name = "Unique"
The following code sets cell A1 to have the name 'MyUniqueName':
Private Sub NameCell()
Dim rng As Range
Set rng = Range("A1")
rng.Name = "MyUniqueName"
End Sub
Does that help?
EDIT
I am not sure how to achieve what you need in a simple way, elegant way. I did manage this hack - see if this helps but you'd most likely want to augment my solution.
Suppose I have the following user defined function in VBA that I reference in a worksheet:
Public Function MyCustomCalc(Input1 As Integer, Input2 As Integer, Input3 As Integer) As Integer
MyCustomCalc = (Input1 + Input2) - Input3
End Function
Each time I call this function I want the cell that called that function to be assigned a name. To achieve this, if you go to 'ThisWorkbook' in your VBA project and select the 'SheetChange' event then you can add the following:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Left$(Target.Formula, 13) = "=MyCustomCalc" Then
Target.Name = "MyUniqueName"
End If
End Sub
In short, this code checks to see if the calling range is using the user defined function and then assigns the range a name (MyUniqueName) in this instance.
As I say, the above isn't great but it may give you a start. I couldn't find a way to embed code into the user defined function and set the range name directly e.g. using Application.Caller.Address or Application.Caller.Cells(1,1) etc. I am certain there is a way but I'm afraid I am a shade rusty on VBA...
I used this sub to work its way across the top row of a worksheet and if there is a value in the top row it sets that value as the name of that cell. It is VBA based so somewhat crude and simple, but it does the job!!
Private Sub SortForContactsOutlookImport()
Dim ThisCell As Object
Dim NextCell As Object
Dim RangeName As String
Set ThisCell = ActiveCell
Set NextCell = ThisCell.Offset(0, 1)
Do
If ThisCell.Value <> "" Then
RangeName = ThisCell.Value
ActiveWorkbook.Names.Add Name:=RangeName, RefersTo:=ThisCell
Set ThisCell = NextCell
Set NextCell = ThisCell.Offset(0, 1)
End If
Loop Until ThisCell.Value = "Web Page"
End Sub
I use this sub, without formal error handling:
Sub NameAdd()
Dim rng As Range
Dim nameString, rangeString, sheetString As String
On Error Resume Next
rangeString = "A5:B8"
nameString = "My_Name"
sheetString = "Sheet1"
Set rng = Worksheets(sheetString).Range(rangeString)
ThisWorkbook.Names.Add name:=nameString, RefersTo:=rng
End Sub
To Delete a Name:
Sub NameDelete()
Dim nm As name
For Each nm In ActiveWorkbook.Names
If nm.name = "My_Name" Then nm.Delete
Next
End Sub