With the use of call statement, I am calling a sub RETURNSEARCHMATCHES that includes UDF FINDCOLLETTEROFNAMEDRANGE(string).
The code where I call the function is below:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
If Selection.Count = 1 Then
If Not Intersect(Target, Range("SearchField")) Is Nothing Then
Call OSS_macros.RETURNSEARCHMATCHES
End If
End If
Application.EnableEvents = True
End Sub
I was debugging the code inside RETURNSEARCHMATCHES and I found out that the UDF function FINDCOLLETTEROFNAMEDRANGE(string) is not called by the sub (the code is below):
Public Function FINDCOLLETTEROFNAMEDRANGE(range_name As String) As String
Dim cell_range As Range
Set cell_range = Range(range_name)
If cell_range.Address(0, 0) <> "" Then
FINDCOLLETTEROFNAMEDRANGE = Left(cell_range.Address(0, 0), 1)
Else
FINDCOLLETTEROFNAMEDRANGE = "NONE"
End If
End Function
Sub RETURNSEARCHMATCHES()
Dim cw As Worksheet
Dim is_matchLeft_name As String
Dim is_matchLeft_col As String
Dim last_row As String
Set cw = Sheets("4c.Travel Costs (Search)")
last_row = CStr(cw.Cells(cw.Rows.Count, 2).End(xlUp).Row)
Debug.Print "OK"
is_matchLeft_name = "Is_Match_from_left"
is_matchLeft_col = FINDCOLLETTEROFNAMEDRANGE(is_matchLeft_name)
Debug.Print is_matchLeft_col
End Sub
Do you know why it is like this?
Am I supposed to pass this UDF function somewhere in the call statement?
Related
I am fairly new to VBA and struglling with the idea on how to merge both of these subs into one, as i need to enable dynamic filters for two separate Pivots.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("L3:L4")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Summary").PivotTables("PivotTable1")
Set xPFile = xPTable.PivotFields("Machine")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub
To combine with this
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("P16:P17")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Summary").PivotTables("PivotTable2")
Set xPFile = xPTable.PivotFields("Machine")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub
Appreciate any help, thank you!
Rather than just Exiting if there is no intersection, flip it around and proceed if there is an intersection.
Your code, refactored along with a few other improvements
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Application.ScreenUpdating = False
If Target.CountLarge > 1 Then
' User changed >1 cells. What now?
Exit Sub
End If
' On Error Resume Next <~~ don't do this globally!
If Not Intersect(Target, Me.Range("L3:L4")) Is Nothing Then
On Error Resume Next '<~~ Keep it tight around a potential error
' If the Change event is on Sheet Summary, use Me instead
Set xPTable = Me.PivotTables("PivotTable1")
' If the Change Event is NOT on Sheet Summary, be explicit on the workbook
'Set xPTable = Me.Parent.Worksheets("Summary").PivotTables("PivotTable1")
On Error GoTo 0
ElseIf Not Intersect(Target, Me.Range("P16:P17")) Is Nothing Then
On Error Resume Next
Set xPTable = Me.PivotTables("PivotTable2")
On Error GoTo 0
End If
If Not xPTable Is Nothing Then
On Error Resume Next '<~~ in case Machine doesn't exist
Set xPFile = xPTable.PivotFields("Machine")
On Error GoTo 0
If Not xPFile Is Nothing Then
xStr = Target.Value ' .Text is dangerous. Eg it can truncate if the column is too narrow
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
End If
End If
Application.ScreenUpdating = True
End Sub
I think there are more options for refactoring.
Put the basic routine into a seperate sub in a modul. This sub can then be called from the _change-events of both sheets. Advantage: if you want to change the logic of the sub - you do it in one place, not two. Or maybe there will be a third sheet that wants to use the same logic. (DRY-principle: don't repeat yourself)
I like to "externalize" on error resume next if necessary into tryGet-functions. Thereby minimizing the risk of its usage (which is in this case ok)
This is the generic sub - based on chris neilsens suggestion plus the comments from VBasic2008
Maybe you adjust the name of the sub to be more precise in what you want to achieve.
Public Sub handleMachineField(Target As Range, RangeToCheck As Range, PTName As String)
On Error GoTo err_handleMachineField
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Application.ScreenUpdating = False
If Target.CountLarge > 1 Then
' User changed >1 cells. What now?
Exit Sub
End If
If Not Intersect(Target, RangeToCheck) Is Nothing Then
Set xPTable = tryGetPivotTable(Target.Parent, PTName)
End If
If Not xPTable Is Nothing Then
Set xPFile = tryGetPivotField(xPTable, "Machine")
If Not xPFile Is Nothing Then
xStr = Target.Value ' .Text is dangerous. Eg it can truncate if the column is too narrow
Application.EnableEvents = False
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.EnableEvents = True
End If
End If
exit_handleMachineField:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
err_handleMachineField:
MsgBox Err.Description
Resume exit_handleMachineField
End Sub
Public Function tryGetPivotTable(ws As Worksheet, PTName As String) As PivotTable
'in case pivot table does not exist no error is thrown
'calling sub has to check for nothing instead
On Error Resume Next
Set tryGetPivotTable = ws.PivotTables(PTName)
On Error GoTo 0
End Function
Public Function tryGetPivotField(pt As PivotTable, FieldName As String) As PivotField
'in case field does not exist no error is thrown
'calling sub has to check for nothing instead
On Error Resume Next
Set tryGetPivotField = pt.PivotFields(FieldName)
On Error GoTo 0
End Function
And this is how you would call it form the worksheet events:
Private Sub Worksheet_Change(ByVal Target As Range)
handleMachineField Target, Me.Range("L3:L4"), "PivotTable1"
End Sub
By the way: this is another advantage of putting the check into a sub. When reading the code in the change-event you immediately know what will happen - you don't have to read through all the code lines to understand what is going on.
My VBA Vlookup code is crashing Excel and takes forever to execute. I need the VBA code and not the formula in the cell.
Private Sub Worksheet_Change(ByVal Target As Range)
Call lookup
End Sub
Sub lookup()
Dim srchres As Variant
Dim srch As Variant
Set sh1 = ThisWorkbook.Sheets("Customer")
Set sh4 = ThisWorkbook.Sheets("Invoice")
On Error Resume Next
srchres = Application.WorksheetFunction.VLookup(sh4.Range("A11:C11"), _
sh1.Range("B2:H99999"), 5, False)
On Error GoTo 0
If (IsEmpty(srchres)) Then
sh4.Range("A12") = CVErr(xlErrNA)
Else
sh4.Range("A12:C12").Value = srchres
End If
On Error Resume Next
srch = Application.WorksheetFunction.VLookup(sh4.Range("A11:C11"), _
sh1.Range("B2:H99999"), 6, False)
On Error GoTo 0
If (IsEmpty(srch)) Then
sh4.Range("A13:C13") = CVErr(xlErrNA)
Else
sh4.Range("A13:C13").Value = srch
End If
End Sub
ThisWorkbook's code for creating a drop-down list
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MySheets As Variant
Dim srchres As Variant
Dim srch As Variant
Set sh1 = ThisWorkbook.Sheets("Customer")
Set sh4 = ThisWorkbook.Sheets("Invoice")
MySheets = Array("sh1", "sh4")
If IsNumeric(Application.match(Sh.Name, MySheets, 0)) Then
If Target.Address = "'sh4'!$A$11" Then
sh4.Range("A2:A9999").Cells(sh4.Range("A2:A9999").Rows.Count + 1, 1) = Target
End If
End If
End Sub
I would like to click on E15 and put the value from E16. How can I do that ?
My code is :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
If Not Intersect(Target, Range("C6")) Is Nothing Then
Call CLICK_BTN_INFOS_CONTRAT
End If
Dim TabRes() As String
If Target.Value = [E15].Value Then
ReDim TabRes(0 To UBound(Split([Target], ",")))
For i = LBound(TabRes) To UBound(TabRes)
TabRes(i) = Split(Split([Target], ",")(i), "-")(1)
MsgBox TabRes(0)
GET_GROUPE_GESTION_CIBLE TabRes(0)
Next i
End If
End Sub
You are using the wrong event handler. In terms of what you ask, see below code:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, ActiveSheet.Range("E15")) Is Nothing Then
Target.Value = Target.Offset(0,1).Value
'or
'Target.Value = ActiveSheet.Range("E16").Value
'or
'ActiveSheet.Range("E15").Value = ActiveSheet.Range("E16").Value
End If
End Sub
EDIT
After seeing your comments I am editing. If you are selecting from a dropdown then your event handler is correct, i.e. Worksheet_Change(). The below should meet your requirements..
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, ActiveSheet.Range("E15")) Is Nothing Then
Dim inputString As String
Dim stringArray As Variant
Dim argString as String
'store E15 to a string variable
inputString = Target.Value
'create array from string
stringArray = Split(inputString, " ")
'store E16 to variable to pass to function call
argString = Target.Offset(1, 0).Value
'call function
GET_GROUPE_GESTION_CIBLE(argString)
End If
End Sub
I am trying to pass row number to UserForm, so it could display data in user friendly way for end user, but having trouble catching this variable on Initialize moment.
Code in the Worksheet module, it should open UserForm and pass row number as variable:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim DataRange As ListObject
Dim xRow As Long
xRow = Target.Row
Set DataRange = Sheets("Forecast").ListObjects("ForecastTable")
If Application.Intersect(Target, DataRange.DataBodyRange) Is Nothing Or Target.Cells.Count > 1 Then
Exit Sub
Else
MsgBox xRow
With FullInfo
.MyProp = xRow
.Show
End With
End If
End Sub
This is the code in UserForm:
Property Let MyProp(xRow As Long)
publicRow = xRow
End Property
Private Sub UserForm_Initialize()
Dim publicRow As Long
MsgBox publicRow
End Sub
From MsgBox I used for testing I determined that code in the sheet module returns correct row number, but then UserForm is initialized it shows 0 as no data is received. Interestingly enough, I put a button in the user form for testing with following code:
Private Sub Save_Click()
MsgBox publicRow
End Sub
After pressing it - it shows correct row number, so it means it passed but only after Initialize event. How should I pass variable to UserForm so it would be available at Initialize event?
I have a solution for you. :)
...so this is your code corrected ...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim DataRange As ListObject
Dim xRow As Integer
Dim FullInfo As Object
xRow = Target.Row
Set DataRange = Sheets("Forecast").ListObjects("Tabela1")
If Application.Intersect(Target, DataRange.DataBodyRange) Is Nothing Or
Target.Cells.Count > 1 Then
Exit Sub
Else
Set FullInfo = New UserForm1
With FullInfo
.Label1.Caption = xRow
.Show
End With
End If
End Sub
... if you want to go further, I have another way to pass a public variable to userForm
You code in sheet
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim DataRange2 As ListObject
Dim xRow As Integer
xRow = Target.Row
Set DataRange2 = Sheets("Arkusz1").ListObjects("Tabela2")
If Application.Intersect(Target, DataRange2.DataBodyRange) Is Nothing Or
Target.Cells.Count > 1 Then
Exit Sub
Else
Call UserFormStart(xRow)
End If
End Sub
Put code to new module (in the worksheet do not work)
'Public rowSelection As Integer 'declare public variable
Public Sub UserFormStart(ByVal rowRef As Integer)
rowSelection = rowRef
UserForm1.Show
End Sub
In your userForm
Private Sub CommandButton1_Click()
MsgBox rowSelection & " it's work"
End Sub
Public Sub UserForm_Initialize()
MsgBox rowSelection
End Sub
It works for me :)
You can check one topic
Excel - VBA : pass variable from Sub to Userform
Tried looking this up but I'm still new to VBA and still pretty confused. I can't figure out how to get the variable from one sub and use it in another sub.
I want to get the variable ListBox1Items from GetListBox1Items and use it in cbSave_Click. I keep getting an error on Set oNewRow = Selection.ListObject.ListRows.Add(1). I tried Dim ListBox1Items As String and Public ListBox1Items As String but that doesn't help.
Does the module location of the sub matter? GetListBox1Items is in a Module. cbSave_Click is in a UserForm.
I looked up using Types but it got confusing.
Private Sub cbSave_Click()
Dim oNewRow As ListRow
Dim rng As Range
Set rng = ThisWorkbook.Worksheets("Creatures").Range("MonsterList")
Set oNewRow = Selection.ListObject.ListRows.Add(1)
With ws
Call GetListBox1
oNewRow.Range.Cells(1, 24).Value = Me.StatBox1.Value
oNewRow.Range.Cells(1, 35).Value = ListBox1Items
End With
End Sub
and GetListBox1 is
Sub GetListBox1()
Dim SelectedItems As String
Dim ListBox1Items As String
With MonsterMaker
For i = 0 To .ListBox1.ListCount - 1
If .ListBox1.Selected(i) = True Then
SelectedItems = SelectedItems & .ListBox1.List(i) & ", "
End If
Next i
ListBox1Items = Left(SelectedItems, Len(SelectedItems) - 2)
End With
End Sub
Take the follow abstract example:
Standard module code:
Option Explicit
Public ListBoxItems As String 'GLOBAL
Sub GetListBoxItems()
Dim selectedItems As String
Dim i as long
With ThisWorkBook.Worksheets("Sheet1").OLEObjects("ListBox1").Object 'amend as appropriate
For i = 0 to .ListCount-1
If .Selected(i) Then
selectedItems = selectedItems & .List(i) & ", "
End If
Next i
ListBoxItems = Left$(selectedItems,Len(selectedItems)-2)
End With
End Sub
In UserForm code:
Private Sub cbSave_Click()
Call GetListBoxItems
Debug.Print ListBoxItems
End Sub