I'm not sure how to ask this question and I'm relatively new to the community.
I am trying to get the position of a button, which I have the code for, and it works.
How can I call the Sub below from another Sub and get the integer value of the row position?
Sub ButtonRow()
' Mainlineup Macro
Dim b As Object, RowNumber As Integer
Set b = ActiveSheet.Buttons(Application.Caller)
With b.TopLeftCell
RowNumber = .Row
End With
'MsgBox "Row Number " & RowNumber
End Sub
There are two ways to pass variables around in VBA.
You can either use Public variables outside of the function, which will have scope outside of their sub, or use a Function, which is designed to return output.
Note that global public variables have certain security implications.
Functions must be named as the variable you intend to return - in this case Function RowNumber(). There are limitations on what you can do with Functions - IIRC functions cannot change any cell, worksheet, or workbook properties.
Sub WhatPosition()
MsgBox RowNumber
End Sub
Public Function RowNumber() As Integer
Dim b As Object
Set b = ActiveSheet.Buttons(Application.Caller)
With b.TopLeftCell
RowNumber = .Row
End With
End Function
or:
Public RowNumber As Integer
Sub WhatPosition()
ButtonRow
MsgBox RowNumber
End Sub
Sub ButtonRow()
Dim b As Object
Set b = ActiveSheet.Buttons(Application.Caller)
With b.TopLeftCell
RowNumber = .Row
End With
End Sub
Related
In Python, we normally pass arguements in the function when we have to call them multiple times as below:
def function_add(a,b):
print(a+b)
function_add(4,5)
function_add(5,7)
function_add(10,4)
function_add(4,6)
Do we have a similar way to implement it in VBA too? I tried to implement it but I couldn't make it. Below is my code.
Private Sub SearchAndInsertRows()
Dim rng As Range
Dim cell As Range
Dim search As String
Dim kk As String
Set rng = ActiveSheet.Columns("A:A")
search = ""
Call searchGetKey(search)
Set cell = rng.Find(What:=search, LookIn:=xlFormulas, LookAt:=xlWhole, MatchCase:=False)
If cell Is Nothing Then
MsgBox "Not Found"
Else
kk = ""
Call searchSetKey(kk)
cell.Value = kk
End If
End Sub
Sub searchGetKey(ByRef getKey As String)
getKey = "a"
End Sub
Sub searchSetKey(ByRef setKey As String)
setKey = "b"
End Sub
Sub searchGetKey and searchSetKey modifies one cell but I need to do the same for number of cells. Is there any other ways to do it?
Please fell free to optimize the code wherever necessary.
Thank you very much and much appreciated. :)
A function in VBA must return something. Otherwise, you should use a Sub:
Function function_add(a As Long, b As Long) As Long
function_add = a + b
End Function
Sub TestFunction()
MsgBox function_add(3, 5)
End Sub
You can use a function without arguments, just returning according to a specific calculation algorithm. For instance:
Function tomorrow_Date() As Date
tomorrow_Date = Date + 1
End Function
It can be called as:
Sub testTommorrow_Date()
MsgBox tomorrow_Date
End Sub
Or a Sub which by default takes arguments ByRef, if not specified ByVal:
Sub Sub_add(a As Long, b As Long, c As Long)
c = a + b
End Sub
And test it as:
Sub TestSub_Add()
Dim c As Long
Sub_add 3, 2, c
MsgBox c
End Sub
Of course, a and b may be declared in the testing Sub and used like arguments, but I wanted saying that they are not relevant against c which was updated after the call...
I need some idea to make this function update in real time. This function count the color of the cells for a work I need.
Function COUNTCOLOR(celdaOrigen As Range, rango As Range)
Application.Volatile
Dim celda As Range
For Each celda In rango
If celda.Interior.Color = celdaOrigen.Interior.Color Then
COUNTCOLOR = COUNTCOLOR + 1
End If
Next celda
End Function
I already try to run this function
Application.CalculateFullRebuild
But It didn't work in real time, I had to assign that function to a button and when I want to update the cells which count the colors I press the button, but that's not what I want. I want the cells count the colors in real time, I want they show me the number immediately I change a color. The cell that count the color has the following formula:
=COUNTCOLOR(A1;A1:A9998)
Where "A1" is a cell of the color I want the cell counts (like a sample), and the "A1:A9998" is the range where I want the formula find the color a the previous assigned sample. The cell will show a number of the cells in the range with the color of the sample.
I hop this information I provided can help you to give me a good answer :)
Thank you so much!
Perhaps, it's not the most elegant solution, but it works. The idea is to run the Sub every 5-10 seconds to make it work in real time.
Here is the code:
Sub COUNTCOLOR()
Dim RunTime
Dim COUNTCOLOR As Integer
Dim celda As Range
Dim lastRow As Variant
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Dim rango As Range
Set rango = Range("A1:A" & lastRow)
For Each celda In rango
'Compare cell interior color with cell A1
If celda.Interior.Color = Cells(1, "A").Interior.Color Then
COUNTCOLOR = COUNTCOLOR + 1
End If
Cells(1, "C").Value = COUNTCOLOR
Next celda
'To run sub every 5 seconds
RunTime = Now + TimeValue("00:00:05")
Application.OnTime RunTime, "COUNTCOLOR"
End Sub
Insert a class module and name it ClsMonitorOnupdate
Put in the code below
Option Explicit
Private WithEvents objCommandBars As Office.CommandBars
Private rMonitor As Range
Public Property Set Range(ByRef r As Range): Set rMonitor = r: End Property
Public Property Get Range() As Range: Set Range = rMonitor: End Property
Private Sub Class_Initialize()
Set objCommandBars = Application.CommandBars
End Sub
Private Sub Class_Terminate()
Set objCommandBars = Nothing
End Sub
Private Sub objCommandBars_OnUpdate()
If ActiveWorkbook.Name <> ThisWorkbook.Name Then Exit Sub
If TypeName(Selection) <> "Range" Then Exit Sub
If Intersect(Selection, rMonitor) Is Nothing Then Exit Sub
rMonitor.Dirty 'dosomething to trigger your function
End Sub
In the ThisWorkbooksection you put:
Option Explicit
Private Const sRanges As String = "A1:A100" 'adjust to your range Rango?
Private Const sSheet As String = "YourSheetName" 'adjust to your sheetname
Private cMonitor As ClsMonitorOnupdate
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set cMonitor = Nothing
End Sub
Private Sub Workbook_Open()
Set cMonitor = New ClsMonitorOnupdate
Set cMonitor.Range = Sheets(sSheet).Range(sRanges)
End Sub
Adjust your Sheetname and range to monitor, after running the WorkBookopen event your range(s) will be monitored and a color-change will recalculate your Countcolor function (you can leave application.volatile out of it)
This is a basic error or lack of understanding on my part. I've searched a number of questions here and nothing seems applicable.
Here is the code
Option Explicit
Public Function ReturnedBackGroundColor(rnge As Range) As Integer
ReturnedBackGroundColor = rnge.Offset(0, 0).Interior.ColorIndex
End Function
Public Function SetBackGroundColorGreen()
ActiveCell.Offset(0, 0).Interior.ColorIndex = vbGreen
End Function
Public Function CountBackGroundColorGreen(rnge As Range) As Integer
Dim vCell As Range
CountBackGroundColorGreen = 0
For Each vCell In rnge.Cells
With vCell
If ReturnedBackGroundColor(vCell) = 14 Then
CountBackGroundColorGreen = CountBackGroundColorGreen + 1
End If
End With
Next
End Function
Public Function GetBackgroundColor() As Integer
Dim rnge As Range
GetBackgroundColor = 3
rnge = InputBox("Enter Cell to get Background color", "Get Cell Background Color")
GetBackgroundColor = ReturnedBackGroundColor(rnge)
End Function
I was adding the last function and everything else was working prior to that and am getting the error on the first statement in that function.
For the error, one of the possible fixes is to add a reference the proper library. I don't know what is the proper library to be referenced and cannot find what library the InputBox is contained. It's an activeX control but I don't see that in the tools->reference pull down. I do have microsoft forms 2.0 checked.
I've tried various set statements but I think that the only object that I've added is the inputbox.
Any suggestions?
thanks.
Use application.inputbox, add the type as range and Set the returned range object.
Option Explicit
Sub main()
Debug.Print GetBackgroundColor()
End Sub
Public Function GetBackgroundColor() As Integer
Dim rnge As Range
Set rnge = Application.InputBox(prompt:="Enter Cell to get Background color", _
Title:="Get Cell Background Color", _
Type:=8)
GetBackgroundColor = ReturnedBackGroundColor(rnge)
End Function
Public Function ReturnedBackGroundColor(rnge As Range) As Integer
ReturnedBackGroundColor = rnge.Offset(0, 0).Interior.ColorIndex
End Function
The idea was to create a variable that would save the changes made to it from previous use of the macro. I have a userform that pulls values from a range and populates unique values in a listbox. I then want to be able to add selected values to my dictionary/collection and save the change. Once all necessary changes have been made, the macro should use the dictionary variable as criteria for an autofilter.
My question is two fold, what class should I use to accomplish this? How can a use this variable to autofilter my worksheet? Userform code is below:
The First bit of code is for the "Add" command button. It is supposed to take the selected value(s) in the listbox and add them to the dictionary titled "Market". The code after that pulls the values from a recently opened excel workbook an displays unique values in the listbox. Listbox2 holds all previous values from past uses of the macro. I want to add a "Delete" button to the userform to tidy up the list if necessary. The two public variables below are actually located on the main macro module, this would allow me to store the values in the dictionary after the userform has stopped running.
Private Sub CommandButton1_Click()
Dim i As Long
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
Market.Add ListBox1.List(i)
Set Market = New Collection
End If
Next
End Sub
Private Sub UserForm_Initialize()
Dim myList As Collection
Dim myRange As Range
Dim ws As Worksheet
Dim myVal As Variant
Dim Col As Integer
Set ws = ActiveWorkbook.Sheets("Daily Unconfirmed")
Col = WorksheetFunction.Match("Marketer", ws.Range("3:3"), 0)
Set myRange = ws.Range(Cells(4, Col), Cells(4, Col).End(xlDown))
Set myList = New Collection
On Error Resume Next
For Each mycell In myRange.Cells
myList.Add mycell.Value, CStr(mycell.Value)
Next mycell
On Error GoTo 0
For Each myVal In myList
Me.ListBox1.AddItem myVal
Next myVal
Public item As Variant
Public Market As Collection
Market.Add "Al D"
Market.Add "B Collins"
Market.Add "B G"
Market.Add "C Huter"
For Each item In Market
Me.ListBox2.AddItem item
Next item
End Sub
Since AutoFilter runs from an array, I would build the array dynamically and use it in a filtering sub:
Dim ary()
Sub MAIN()
Call BuildDynamicArray
Call FilterMyData
End Sub
Sub BuildDynamicArray()
Dim inString As String
i = 1
While 1 = 1
x = Application.InputBox(Prompt:="Enter a value", Type:=2)
If x = False Then GoTo out
ReDim Preserve ary(1 To i)
ary(i) = x
i = i + 1
Wend
out:
End Sub
Sub FilterMyData()
ActiveSheet.Range("$A$1:$A$10").AutoFilter Field:=1, Criteria1:=ary, Operator:=xlFilterValues
End Sub
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