I'm using VBA to perform a search on a pivot field and I want to be able to do a search based on whether the field contains a portion of the string but am unsure of how to do this without checking for the whole value. Bellow is what I currently have:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'This line stops the worksheet updating on every change, it only updates when cell
'P4 is touched
If Intersect(Target, Range("B4")) Is Nothing Then Exit Sub
'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewPull As String
'Here you amend to suit your data
Set pt = Worksheets("Pull Code Search").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Pull Code")
If IsEmpty(Range("B3").Value) = True Then
NewPull = "(All)"
Else
NewPull = Worksheets("Pull Code Search").Range("B3").Value
End If
'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters
Field.CurrentPage = NewPull
If NewPull = "(All)" Then
ActiveSheet.PivotTables(1).PivotFields(1).ShowDetail = False
End If
pt.RefreshTable
End With
End Sub
Use INSTR.
This function returns the position of first occurrence of substring in a string. You no need to loop through the whole string.
If your portion of the string (substring) exists in the actual "string", this function returns a positive value.
"The INSTR function can only be used in VBA code in Microsoft Excel."
The syntax
InStr( [start], string, substring, [compare] )
More description here:
https://www.techonthenet.com/excel/formulas/instr.php
Related
I have a template with a set number of columns (170) and title headers (row 1 cell name's). This is always the same, until users add columns in between (they're instructed not to change headers). The idea is to make it tamperproof as far as the adding of columns is involved.
I'd like to make variables to hold some of the headers (with the capacity to hold all) and check these with the template to find out the column number (in a loop I reckon). It's probably wisest to make a function to call upon it?
Dim ColHeader1Str as string 'literal row 1, column 1 value (which is always
'the same string and position in the template)
Dim iColHeader1 as integer 'holds the (to be set) value of the column number
Set ColHeader1Str = "ColHeader1"
Now I'd like a loop where it loops trough all the columns (last column = 200) and checks to see what the column number is that matches the ColHeader1Str and store this in the iColHeader1
So something like:
Function find_columnNmbr
Dim i As Integer
For i = 1 To 200 Step 1
If 'ColHeader1Str matches actual column header name
'set found integer as iColHeader1 and so forth
Exit For
End If
Next
End Function`
I know I'm missing a few steps and I'm hoping you guys can help me out.
Update: The template has set column headers. When users interact with it a result could be that columns shift position, or they add more. I have a workbook that needs to load data out of the user's altered template.
I.E. The template has columns 1, 2, 3, 4 and the names are column1, column 2 etc. A user ads a random column so now there are 5. The loop needs to loop through the names of the column headers and identify the column number of the original template columns 1, 2 etc based on a string variable with the original names, which I've hard coded beforehand. These are public constants.
What function LookForHeaders do: input a string, then search for the string in usersheet.range(1:1). If it is found, return the column number of that cell, otherwise it returns 0.
Private Function LookForHeaders(ByVal headerName As String) As Long
Dim rng As Range
Dim userSheet As WorkSheet
Set userSheet = 'userSheet here'
On Error GoTo NotFound
LookForHeaders = userSheet.Range("1:1").Find(headerName).Column
Exit Function
NotFound:
LookForHeaders = 0
End Function
Private Sub Test()
Dim rng As Range
Dim template As WorkSheet
Set template = 'template here'
For Each rng In template.Range(Cells(1,1), Cells(1,200))
iColHeader1 = LookForHeaders(rng.Value)
'Do something with iColHeader1
Next rng
End Sub
Not sure what your looking for but here is example
Option Explicit
Public Sub Example()
Dim LastCol As Long
Dim i As Long
LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For i = 1 To LastCol
If Cells(i) = "Name" Then
Debug.Print Cells(i).Address
End If
Next
End Sub
Hi I am trying to create a function to calculate milliohms (mOhms)
my function is
Function mOhms(Current, Voltage)
mOhms = Format((Voltage / Current) * 1000, "00.00 m") & Chr(87)
End Function
with results being
40.00 mW
(if cell values are 24 and 1 respectivly)
How do i get the W as (Ω) ohms symbol
if i change the cell font style to Symbol m changes to micro (μ) symbol
i have tried paying with
With ActiveCell.Characters(Start:=Len(ActiveCell) - 1, Length:=1).Font
.FontStyle = "Symbol"
End With
Which results in "Circular reference error"s
Need some help to resolve this
Try using Unicode in place of the Chr(87)
Function mOhms(Current, Voltage)
mOhms = Format((Voltage / Current) * 1000, "00.00 m") & ChrW(&H2126)
End Function
should you want to stick with Characters object you have to:
use Name property, instead of FontStyle one
set its Start parameter to the last character of the range text, instead of the second to last one
so you may want to code like follows:
Sub main()
With Range("G1") '<--| change this to any valid Range reference
.Value = mOhms(24, 1) '<--| set the referenced range value
FormatOhm .Cells '<--| format the referenced range value last character
End With
End Sub
Function mOhms(Current, Voltage)
mOhms = Format((Voltage / Current) * 1000, "00.00 m") & Chr(87)
End Function
Sub FormatOhm(rng As Range)
With rng
.Characters(Start:=Len(.Value), Length:=1).Font.name = "Symbol"
End With
End Sub
a possible enhancement of which could be the handling of "W" character actual position in the string, should it not always be the last character
then you could add the following function:
Function GetCharacter(rng As Range, char As String) As Long
Dim i As Long
With rng
For i = 1 To .Characters.Count
If .Characters(i, 1).Text = char Then
GetCharacter = i
Exit For
End If
Next i
End With
End Function
that returns a Long with the passed character position inside the passed range value or 0 if no match occurred
in this case you'd have to slightly change FormatOhm() function to have it handle the actual character position:
Sub FormatOhm(rng As Range, iChar As Long)
If iChar = 0 Then Exit Sub '<--| exit if no character matching occurred
With rng
.Characters(Start:=iChar, Length:=1).Font.name = "Symbol"
End With
End Sub
and your "main" code would then get to:
Sub main()
With Range("G1") '<--| change this to any valid Range reference
.Value = mOhms(24, 1) '<--| set the referenced range value
FormatOhm .Cells, GetCharacter(.Cells, "W") '<--| format the referenced range value character corresponding to "W", if any
End With
End Sub
of course what above could be further both improved and made more robust, for instance handling char parameter length in GetCharacter() and correspondingly in FormatOhm()
I am trying to create a module to share functionality across a number of worksheets within a single workbook. All works fine apart from some filter code.
The code below works fine if I place it in a single worksheet
ActiveSheet.PivotTables("PivotTable1").PivotFields("MyField"). _
ClearValueFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("MyField").PivotFilters.Add Type:=xlValueIsBetween, DataField:=ActiveSheet.PivotTables _
("PivotTable1").PivotFields("MyValue"), Value1:=bottom, Value2:=Top
However, I want to use this code in my Module and send it the following: Pivot Table Name, Row PivotField, Value Pivot fieldtop "between" valuebottom "between" value
Something like:
The sheet call
Call Mod_Filter("PivotTable1", "MyRowFieldName", "MyValueFieldName", 0, intvalue)
The Module code
Public Sub Mod_Filter(ByRef PT_Name As String, ByRef StaticField As String, ByRef Filter_field As String, bottom As Double, Top As Double)
ActiveSheet.PivotTables(PT_Name).PivotFields(StaticField).ClearValueFilters
ActiveSheet.PivotTables(PT_Name).PivotFields(StaticField).PivotFilters.Add Type:=xlValueIsBetween, DataField:=ActiveSheet.PivotTables _
(PT_Name).PivotFields(Filter_field), Value1:=bottom, Value2:=Top
End Sub
However, I cannot get this to work. Any suggestions??
So I'm using the "St" Row to filter the YTD% based on a value selected from a dropdown combo box
Requirement:
To filter a Pivot RowField based on a Pivot DataField
This procedure uses the PivotField.SourceName to validate & set the DataField to apply the Filter Type and Values.
Sub Ptb_Filter_Between(WshTrg As Worksheet, _
sFldTrg As String, sFldDta As String, dFromVal As Double, dToValue As Double)
Dim pTbl As PivotTable, pFldDta As PivotField
Rem Application Settings - OFF
Application.ScreenUpdating = False
Application.EnableEvents = False
Rem Set PivotTable
'Using Index 1 as OP confirmed there is only one PivotTable per Sheet
'If this condition change then PivotTable Index should be provided as an argument
Set pTbl = ActiveSheet.PivotTables(1)
With pTbl
Rem Set DataField - User provides the Data Field
For Each pFldDta In .DataFields
If pFldDta.SourceName = sFldDta Then Exit For
Next
If pFldDta Is Nothing Then GoTo ExitTkn
Rem Filter PivotField
.ClearAllFilters 'Use this line to clear all PivotTable Filters
On Error GoTo ExitTkn
With .PivotFields(sFldTrg)
.ClearAllFilters 'This line clears all PivotField Filters
.PivotFilters.Add2 Type:=xlValueIsBetween, _
DataField:=pFldDta, Value1:=dFromVal, Value2:=dToValue
End With: End With
ExitTkn:
Rem Application Settings - ON
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
These are some samples of how to call the procedure:
sFldTrg = "Type"
sFldDta = "Amount"
dFromVal = 25000
dToValue = 30000
Call Ptb_Filter_Between(Worksheet Object, sFldTrg, sFldDta, dFromVal, dToValue)
sFldTrg = "Type"
sFldDta = "YTD%"
dFromVal = 0.3
dToValue = 0.35
Call Ptb_Filter_Between(Worksheet Object, sFldTrg, sFldDta, dFromVal, dToValue)
sFldTrg = "Row"
sFldDta = "YTD%"
dFromVal = 0.1 'To set from value as 10%
dToValue = 0.2 'To set to value as 20%
Call Ptb_Filter_Between(Worksheet Object, sFldTrg, sFldDta, dFromVal, dToValue)
Context:
I have several lists in my sheet (1 column wide, 1-10 rows long). When I right click a cell in these lists, I can do several options, that all work well. I have given a name to the cell at the top of each of these lists (ex. Cell A1 has been given the name cell_1, B10 is names cell_2, etc).
I would like to know if the cell I am right clicking on is the one at the top of the list; is it named "cell_(number)"? If it is not, it checks the cell on top of that one. Does it have a name that starts with "cell_"? If not, check the one on top, etc. Until I can figure out the user clicked on an element of WHICH list.
TL;DR The actual question
I can use ActiveCell.Address, which gives me something like "A1" whether or not I have assigned a name to that cell. ActiveCell.Name gives "Sheet1!A1", so it's not much better. Any idea how to get it to return the name I have assigned instead?
Create a UDF to test the application names, it's less efficient but contains error handling within the function itself:
Sub SO()
'// Example how to call function
Debug.Print GetCellName(Range("A1"))
End Sub
Function GetCellName(myCell As Excel.Range) As Variant
Dim nameCheck As Variant
For Each nameCheck In Application.Names
If Replace(Replace(Replace(nameCheck, "=", ""), "'", ""), "!", "") = _
CStr(myCell.Parent.Name & myCell.Address) Then
GetCellName = CStr(nameCheck.Name)
Exit Function
End If
Next
GetCellName = CVErr(Excel.xlErrName)
End Function
Note you can also use this function in a worksheet cell like so:
=GetCellName(A1)
Perhaps this would work. This function returns the names assigned to a cell (or bigger range for that matter). If there's more than one name, it returns it as an array for array formula...or the user can supply an index to return only the desired name position
Public Function CellIsInRangeNames(sheetname As String, checkRange As Range, Optional itemNumber As Variant) As Variant
Dim oNM As Name
Dim oSht As Worksheet
Dim isect As Range
Dim namesCollection() As Variant
Set oSht = Worksheets(sheetname)
Dim i As Integer
i = -1
For Each oNM In oSht.Names
Set isect = Application.Intersect(Range(oNM.Name), checkRange)
If Not isect Is Nothing Then
i = i + 1
ReDim Preserve namesCollection(0 To i)
namesCollection(i) = CStr(oNM.Name)
End If
Next oNM
If i = -1 Then
'didn't find any
CellIsInRangeNames = xlErrName
ElseIf Not IsMissing(itemNumber) Then
'user wanted this instance only
If (itemNumber - 1 > UBound(namesCollection)) Or (itemNumber - 1 < LBound(namesCollection)) Then
CellIsInRangeNames = xlErrValue
Else
CellIsInRangeNames = namesCollection(itemNumber - 1)
End If
Else 'here's the list as an array
CellIsInRangeNames = namesCollection
End If
End Function
I have the need to execute some VBA code when a sheet changes. For this I have an If-then-else situation.
In any particular row (I have a variable number of rows (i.e. line items)):
if column "Type" = Range("A") then
column "Amount" needs to be unlocked
set to the value of Range("B") and locked
else if column "Type" = Range("C") then
column "Amount" needs to be unlocked
set to the value of Range("C") and locked
else
the column "Amount" needs to unlocked.
In the worksheet change event, I unlock/lock using ActiveSheet.Protect and .Unprotect with a password from a range.
I am now trying to figure out how to do this. Specifically, how do I use the column names - like in formula's?
=== for Excel 2007+ ===
If you are using Excel 2007+, I recommend using ListObject, ListColumns and ListRows (study the object model).
Philosophy behind my approach:
Forms, Data and Reports should always be separated, so...
Gather all your data into a Table, in a dedicated sheet. Select your data and Ctrl+(T or L). Make sure every sheet has only 1 table of data.
Using Tables, you'll be able to make use of the ListObject, ListColumns and ListRows objects.
Here's the finished code for the entire thing.
Public Sub test()
IntersectColumnRows ActiveSheet, "", "Type", "Amount", Range("A1"), Range("B1"), Range("C1")
End Sub
Public Sub IntersectColumnRows(currentSheet As Worksheet, sheetPassword As String, columnTitle_Type As String, columnTitle_Amount As String, rangeA As Range, rangeB As Range, rangeC As Range)
'variable declaration
Dim listO As ListObject
Set listO = currentSheet.ListObjects(1)
'Takes care of sheet protection
Dim isSheetProtected As Boolean
isSheetProtected = currentSheet.ProtectionMode
If isSheetProtected Then _
currentSheet.Unprotect (sheetPassword)
'store your type column
Dim columnRangeType As Range
Set columnRangeType = listO.ListColumns(columnTitle_Type).Range
'store your 2nd column
Dim columnRangeAmount As Range
Set columnRangeAmount = listO.ListColumns(columnTitle_Amount).Range
'the actual routine you are asking for
Dim listR As ListRow
For Each listR In listO.ListRows
'intersect the TYPE column with the current row
Dim typeRangeIntersection As Range
Set typeRangeIntersection = Application.Intersect(listR.Range, columnRangeType)
'intersect the AMOUNT column with the current row
Dim amountRangeIntersection As Range
Set amountRangeIntersection = Application.Intersect(listR.Range, columnRangeAmount)
'the logic you required
If typeRangeIntersection.Value = rangeA.Value Then
amountRangeIntersection.Locked = False
amountRangeIntersection.Value = rangeB.Value
amountRangeIntersection.Locked = True
ElseIf typeRangeIntersection.Value = rangeC.Value Then
amountRangeIntersection.Locked = False
amountRangeIntersection.Value = rangeC.Value
amountRangeIntersection.Locked = True
Else
amountRangeIntersection.Locked = False
End If
Next
'Cleans up sheet protection
If isSheetProtected Then _
currentSheet.Protect (sheetPassword)
End Sub
Here's the "how-I-did-it":
Store the ListColumn.Range for all required columns (Type, Amount)
For-loop with every ListRow...
I intersect the ListRow.Range with the ListColumn.Range
Apply your desired logic
Beyond the code, study how...
I included the PROTECT/PASSWORD logic in there, so you can remove it if you want to.
Each variable has a very explicit name
I didn't include any hard-coded value so it remains parametric, if you need to adapt some stuff for different sheets