In Excel 2013, I'm using named ranges on a sheet of reference data to reference constants in a bunch of formulae on another sheet.
Is there any way to display the name of the range next to the range itself? For instance, if I have cell AB23 named SC_Item, is there any way to make AC23 display "SC_Item", perhaps with something along the lines of =RANGENAME(AB23) (completely made up, of course) or similar?
Unless there's a built in method (I haven't used 2013 yet) then this code will do the job.
It will check to see if the Target cell is within a named range and works for single cell named ranges or a cell that is part of a larger named range.
Public Function NamedRange(Target As Range) As String
Dim vName As Variant
For Each vName In ThisWorkbook.Names
If Not Intersect(Target, Range(vName)) Is Nothing Then
NamedRange = vName.Name
Exit For
End If
Next vName
End Function
This will work if your named range is just a single cell (although I'm sure there's a better way).
Public Function NamedRange1(Target As Range) As String
On Error GoTo ERROR_HANDLER
NamedRange1 = Target.Name.Name
On Error GoTo 0
Exit Function
ERROR_HANDLER:
Select Case Err.Number
Case 1004 'Application-defined or object-defined error.
NamedRange1 = Target.Address
Resume Next
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure Module1.NamedRange1."
Application.EnableEvents = True
End Select
End Function
Related
I have some VBA code that I would like to set the format (forecolour) of all cells in a given workbook that match some criteria (essentially this is to auto-mark use of a particular UDF). If the user has protected sheets in their workbook, they may have (sensibly) protected them in such a way that formatting is still permitted.
How do I check (from the VBA Range object representing the cell) whether a cell on any given worksheet is good to make format edits to?
I am aware the route-one answer to this will be an error handler to try it and handle the cases that fail - but as this has to run on every cell in the UsedRange of every sheet, I want it to be fast. I also realise that this is VBA, so there may not be a faster or more elegant way - but there is a lot of collected wisdom on here, hence my asking!
I think error handling is still the way to go. But as far as I can tell, if formatting fails for one cell in your sheet, it will fail for all other cells, even if those cell are unlocked.
Try the following strategy: The idea is that if formatting fails for any cell, you stop attempting to format the current sheet and move on to the next.
Sub MyProcedure()
Dim sht As Worksheet
Dim cl As Range
For Each sht In ThisWorkbook.Sheets
For Each cl In sht.UsedRange
On Error Resume Next
' Format the cell in a DIFFERENT procedure so that
' if an error occurs the rest of formatting lines are
' are not attempted (this is the key idea)
ApplyFormat cl
If Err.Description = "Application-defined or object-defined error" Then
Err.Clear
Exit For
End If
Next cl
'* Either reset your error handling here if you have more code for each sheet
On Error GoTo 0
' ...more code
Next sht
'* Or eset you error handling here
On Error GoTo 0
' ...more code
End Sub
Sub ApplyFormat(cl As Range)
' apply your formatting here
End Sub
You need to firstly check if the sheet is protected and do what you need if not.
If Protected, you should check only the range you try changing if is locked, has cells locked on is not and do the job only if is unlocked. You cannot check if the cells have a protected format... The next code will show you (I think) what is to be done in such a case:
Sub testSheetProtectedLockedCells()
Dim sh As Worksheet, rng As Range
Set sh = ActiveSheet: Set rng = sh.Range("A2:C4")
'Just for testing: _________________________________________
rng.Locked = Not rng.Locked 'lock - unlock the range...
rng.cells(1, 1).Locked = Not rng.cells(1, 1).Locked ' lock-unlock one cell of the range
'___________________________________________________________
If Not sh.ProtectionMode Then
DoIt rng
Else
If rng.Locked = False Then
DoIt rng
ElseIf IsNull(rng.Locked) Then
MsgBox "Cell(s) of the range """ & rng.address & """ are locked." & vbCrLf & _
"Please, unlock all the range and run the code again!", vbInformation, _
"Locked cells in the range to be processed..."
Else
MsgBox "The range """ & rng.address & """ is locked." & vbCrLf & _
"Please, unlock it and run the code again!", vbInformation, _
"Locked range to be processed..."
End If
End If
End Sub
Sub DoIt(rng As Range) 'do here the job you need...
Debug.Print rng.address, rng.Locked
End Sub
How can I resolve the type mismatch error (indicated)?
If I want to restrict the sub to the specified ranges, why would changing If Not Intersect to If Intersect exit the sub?
Private Sub Workbook_SheetBeforeDoubleClick(ByVal sH As Object, ByVal Target As Range, Cancel As Boolean)
' Exclude specified ranges
Dim rExcl(1) As Range, i As Integer, r As Range
Set rExcl(0) = Range("Table1"): Set rExcl(1) = Range("Table2")
For i = 0 To 1
For Each r In rExcl(i)
If r.Parent Is sH Then
If Not Intersect(Target, r) Is Nothing Then Exit Sub ' Type mismatch error
End If
Next
Next
End Sub
It seems that the purpose of the code posted is to validate if the user double-clicked a cell within any of the Tables (i.e.: Table1 or Table2), if so then Exit Sub.
In regards to the questions:
1. How can I resolve the type mismatch error (indicated)?
If Not Intersect(Target, r) Is Nothing Then Exit Sub ' Type mismatch error
Unfortunately, this error cannot be reproduced. This error is triggered when the data type of a variable differs to what is required. In this case it seems "almost" impossible because:
Intersect expects ranges and both variables (Target and r) are defined as ranges.
Intersect returns an object (range) which is what Is Nothing is expecting.
Intersect could also return an Error when the ranges have different parents, but that situation is already taken care by this line If r.Parent Is Sh Then.
The proposed solution includes a method to debug this error when it happens.
2. If I want to restrict the sub to the specified ranges, why would changing If Not Intersect to If Intersect exit the sub?
This is happening because the code posted is validating the ranges cell by cell, therefore if the user double-clicked the last cell of the table then the code compares the first cell and because there is no intersection the code exits the sub.
Bear in mind that the purpose is to validate if the double-clicked cell belongs or not to any of the tables ( i.e.: “ranges intersection”, if one cell intersect or not with a range, then the entire range intersects or not), as such there is no need to validate each cell, instead validate the entire range at once.
Proposed Solution:
Note that the ERR_Intersect subroutine should be just temporary, it is include to help analyze the mismatch error.
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim rExcl(1) As Range, vRng As Variant
Set rExcl(0) = Range("Table1")
Set rExcl(1) = Range("Table2")
For Each vRng In rExcl
Rem Validate Worksheet
If vRng.Parent Is Sh Then
Rem Validate Target
On Error Resume Next
If Not Intersect(Target, vRng) Is Nothing Then
blErr = Error.Number <> 0
On Error GoTo 0
If blErr Then GoTo ERR_Intersect
Exit Sub
End If
On Error GoTo 0
End If: Next
Exit Sub
ERR_Intersect:
Debug.Print vbLf; "Error: "; Err.Number; " - "; Err.Description
Debug.Print "Object"; Tab(11); "TypeName"; Tab(21); "Address"; Tab(31); "Parent"
Debug.Print "Target"; Tab(11); TypeName(Target);
Debug.Print Tab(21); Target.Address(0, 0);
Debug.Print Tab(31); Target.Parent.Name;
Debug.Print
Debug.Print "vRng"; Tab(11); TypeName(vRng);
Debug.Print Tab(21); vRng.Address(0, 0);
Debug.Print Tab(31); vRng.Parent.Name;
Debug.Print
MsgBox "Error: " & Err.Number & " - " & Err.Description & vbLf & _
vbTab & "See Immediate Window for details."
Exit Sub
End Sub
Your code works without any problem in the way you presented and it will also work in the way you try understanding, but with a different meaning, respectively:
You should understand that Intersect returns a 'Range' and the above code checks if this Range exists. In words, this part should be understood as "If the two ranges are intersecting".
This part If Intersect(Target, r) Is Nothing Then Exit Sub means "If the two ranges are not intersecting" (such an eventual intersection does not exist).
No any 'Type mismatch' should exist in both mentioned variants, if you are referring to real tables. It may appear if you named a different object (not a range) as 'TableX'...
Please, try inserting the next code line:
Debug.Print TypeOf rExcl(0) Is Range, TypeOf rExcl(1) Is Range: stop
after:
Set rExcl(0) = Range("Table1"): Set rExcl(1) = Range("Table2")
What does it return in Immediate Window?
Edited:
You could not 'reproduce the error in Debug.Print' because that line is not even reached...
There is a conflict in your workbook. There is the Workbook event you show us in the question and another Worksheet_BeforeDoubleClick event which tries closing the Excel application if the double clicked cell is the one you claim as being 'strange'...
The sheet event is triggered first and the Workbook one is not triggered anymore, since the code tries quitting Excel application. Try put Exit Sub as the first code line in the Worksheet event and try the double click again.
Nothing wrong will happen after that...
I am trying to do the standard deviation of ranged cells using this formula
Private Sub cmdStandardDeviation_Click()
txtStandardDeviation = StDev(Range("A19:I19"))
End Sub
But finally i realized that this may result to further errors because im working on so many cells.
What i am trying to do is by using the userform from VB Excel, i want the user to select the desired ranged of cells and then the user calculate the standard deviation in a click of a button and the result will be posted to the input box of txtStandardDeviation. Instead of i'm coding it using the above syntax, because if new cells is added, the code that i'm writing is no longer valid.
I thought this was simple after a few trials, but still i can't manage to do this. Thank you so much for your help!
You could approach this from a few different angles.
Using a selection
Having the user input the range as text
Getting the range dynamically either from a Named Range or VBA
Selection
If the user has access to the worksheet directly, a possible solution would be to have them select the cells they wish to calculate. Any functions could then be run on that range by using Selection.
Text input
Another way would be to have a way for the user to input text and parse that as a range. You could include various types of fields if that's something that would help the user. For example they could also input ranges to exclude from the calculation.
Named Range
You could use dynamic ranges without any user input at all if the user doesn't need control over specific cells. This would work well if you need to calculate all cells or a known group of cells. Here I have two formulas on a second sheet that calculate the height and width of the range with COUNTA.
VBA
Or you might go as far as to specify the range to be calculated entirely by using VBA. In this example I'm getting the all of the values with SpecialCells(xlCellTypeConstants).
Example Setup
Option Explicit
Private Function ParseRangeInput(textInput As String) As Range
On Error GoTo ErrHandler:
Dim rangeOutput As Range
Set rangeOutput = ActiveSheet.Range(textInput)
Set ParseRangeInput = rangeOutput
Exit Function
ErrHandler:
Debug.Print textInput & " Could not be converted to range."
Set ParseRangeInput = Null
End Function
Private Function StDevWithSelection() As Double
On Error GoTo ErrHandler:
StDevWithSelection = WorksheetFunction.StDev(Selection)
Exit Function
ErrHandler:
Debug.Print "Couldn't get StDev with selection."
StDevWithSelection = 0
End Function
Private Function StDevWithManualRange() As Double
On Error GoTo ErrHandler:
Dim rangeTarget As Range
Set rangeTarget = ParseRangeInput(TextManual.Text)
StDevWithManualRange = WorksheetFunction.StDev(rangeTarget)
Exit Function
ErrHandler:
Debug.Print "Couldn't get StDev with manual range."
StDevWithManualRange = 0
End Function
Private Function StDevWithNamedRange() As Double
On Error GoTo ErrHandler:
Dim rangeTarget As Range
Set rangeTarget = ActiveSheet.Range("Numbers")
StDevWithNamedRange = WorksheetFunction.StDev(rangeTarget)
Exit Function
ErrHandler:
Debug.Print "Couldn't get StDev with named range."
StDevWithNamedRange = 0
End Function
Private Function StDevWithVBARange() As Double
On Error GoTo ErrHandler:
Dim rangeTarget As Range
Set rangeTarget = ActiveSheet.Range("A:Z").Cells _
.SpecialCells(xlCellTypeConstants)
StDevWithVBARange = WorksheetFunction.StDev(rangeTarget)
Exit Function
ErrHandler:
Debug.Print "Couldn't get StDev with VBA range."
StDevWithVBARange = 0
End Function
Private Sub ButtonGo_Click()
If OptionSelection.Value = True Then
TextResults.Text = StDevWithSelection
ElseIf OptionManual.Value = True Then
TextResults.Text = StDevWithManualRange
ElseIf OptionNamed.Value = True Then
TextResults.Text = StDevWithNamedRange
ElseIf OptionVBA.Value = True Then
TextResults.Text = StDevWithVBARange
Else
Debug.Print "No option selected."
End If
End Sub
I have a format of table which is with filters and I made the filter to filter all the table based on the cells in column D3 that with value not blank. Now I am trying to make the filter work automatically based on any change on the list on cell G1.
I tried to use the pivot table but this did not work, as this type of table is not part of pivot table (formatted as table).
What is the correct code that can be used for such sorting?
The sheet is Sheet 1, the table named (PT).
The following code will be activated only if the value in G1 is changed.
Open VBE using Alt+F11, open "Sheet 1" module and paste the given code.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errH
If Not Intersect(Target, Me.Range("G1")) Is Nothing Then
Application.EnableEvents = False
'Put here things that you want to be done if G1 value is changed
'For example:
MsgBox "G1 was changed."
Application.EnableEvents = True
End If
Exit Sub
errH:
MsgBox ("Error number: " & Err.Number & ". Description: " & Err.Description)
Application.EnableEvents = True
End Sub
You can test it - just change the G1 value and you will see that it works.
However, I do not understand your explanation about what you want to filter. But whatever it is, just put the code in the place which I identified and remove that MsgBox.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim criteriaparameter As String
Dim criteriavalue As String
On Error GoTo errH
If Not Intersect(Target, Me.Range("G1")) Is Nothing Then
Application.EnableEvents = False
criteriaparameter = ActiveSheet.Range("J1").Value
criteriavalue = ">=" & criteriaparameter
ActiveSheet.Range("$A$8:$L$8").AutoFilter Field:=10, Criteria1:=criteriavalue, _
Operator:=xlAnd
Application.EnableEvents = True
End If
Exit Sub
errH:
MsgBox ("Error number: " & Err.Number & ". Description: " & Err.Description)
Application.EnableEvents = True
End Sub
I know that in VBA, we can do
Cells(4, 2).Value = 100 'the cell is an integer
Cells(4, 2).Value = True 'the cell is Boolean
Cells(4, 2).Value = "abc" 'the cell is Text
Is it possible to fix or declare the type of a cell, for instance, let Cells(4,2) accept only Boolean, such that assigning an Integer or Text to Cells(4, 2) gives an error?
[EDIT This solution can be implemented from VBA, but it cannot be used from VBA, i.e. can't prevent VBA user from setting cell value to be anything (though not manually in Excel sheet). Not sure what the OP actually wants.]
Use Data Validation.
You can do it via VBA:
Range("A1").Validation.Add Type:=xlValidateList, Formula1:="TRUE,FALSE"
or manually: (In Excel 2003: Data > Validation...)
Now you can enter only boolean TRUE or FALSE in cell A1. If you try to enter something else, e.g. a number:
Using data validation, you can also restrict the cell to accept only numbers, only integers, text of a certain length, basically anything. For example, to accept only text and not numbers, you would use Allow: Custom, Formula: =NOT(ISNUMBER(A1)).
If you actually want the cell type to be specified, you can't. All cells in VBA contain variant data types, to the best of my knowledge.
If you mean the data type of the variant, then sure, you can do it one way or another. Here's a suggestion, it's a little quick and dirty but it works. You'll need to put it in your worksheet code module. Note that it doesn't test if your bool range, int range, whatever intersect, that could cause you some problems if they do.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo handler
Dim cell As Range, _
boolRng As Range, _
intRng As Range
Set boolRng = Union(Sheet1.Range("A1:B2"), Sheet1.Range("E:E"))
Set intRng = Union(Sheet1.Range("B7:K12"), Sheet1.Range("M:M"))
If Not Intersect(Target, boolRng) Is Nothing Then
For Each cell In Intersect(Target, boolRng)
If cell.Value <> "" Then
cell.Value = CBool(cell.Value)
End If
Next cell
End If
If Not Intersect(Target, intRng) Is Nothing Then
For Each cell In Intersect(Target, intRng)
If cell.Value <> "" Then
cell.Value = CInt(cell.Value)
End If
Next cell
End If
Exit Sub
handler:
Select Case Err.Number
Case 13 'Type mismatch, raised when cint/cbool/c*** fails
cell.Value = ""
Resume Next
Case Else
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Select
End Sub
Edit: I note you want to raise an error if the value is assigned incorrectly, you can do that in the error handling section. Instead of
Cell.value = ""
Resume Next
You could use
Err.Raise ISuggestAnEnumForErrorNumbers, "Sheet1.Worksheet_Change(Event)", "Attempted to assign wrong type to cell."
I second JFC's suggestion on using Data Validation.
To test it, place this code in a module (TRIED AND TESTED)
Sub Sample()
With Sheets("Sheet1").Range("A1")
.Validation.Delete
.Validation.Add Type:=xlValidateList, Formula1:="TRUE,FALSE"
.Value = "SID"
End With
End Sub
and this in the relevant sheet
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
If Not Intersect(Target, Range("A1")) Is Nothing Then
Application.EnableEvents = False
On Error Resume Next
If Not Target.SpecialCells(xlCellTypeSameValidation).Cells.Count < 1 Then
Dim currentValidation As Excel.Validation
Set currentValidation = Target.Validation
If currentValidation.Type = xlValidateList Then
'~~> I am using INSTR. If you want you can split it using "," as delim
'~~> and check for the value.
If Not InStr(1, currentValidation.Formula1, Target.Value, vbTextCompare) Then
MsgBox "Incorrect Value"
Target.ClearContents
End If
End If
End If
On Error GoTo 0
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
Now try running the Sub Sample() in the module.