I would like to use mouse clicks as a way of incrementing or substracting values from cells on Gsheets
I came across the following piece of code for excel which works perfectly but I need the equivalent code for Google sheets if possible. Thank you for your help in advance!
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
Cancel = True
Target = Target - 0.05
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
Cancel = True
Target = Target + 0.05
End If
End Sub ```
You could create a button with "Insert - Drawing", and apply this script:
function increment() {
var range = SpreadsheetApp.getActiveRange()
var value = range.getValue()
if(value == ""){value = 1}
else if(typeof(value)!="number"){SpreadsheetApp.getActive().toast("It's not a number");}
else(value++)
range.setValue(value)
}
If the selected cell is empty, it will asign 1; if it is text, it will return a prompt; and if it's a number will add 1
Related
I need to dev Listener to detect changes of isVisible setting for a rows in calc.
Even better it would be for me to have autofilter changes listener - this is also beyond my skills. I would be appreciative for any or both solutions help.
XEventListener nor XModifyListener dont detects this changes.
Maybe try to use XChangesListener XChangesNotifier? <- anyway, i had problem to implement it for tests too
Sub add_eventsListener
Dim ePrefix As String, eService As String
ePrefix = "event_"
eService = "com.sun.star.document.XEventListener"
If IsNull(mEventHandler) Then
mEventHandler = CreateUnoListener(ePrefix, eService)
ThisComponent.addEventListener(mEventHandler)
EndIf
End Sub
Sub event_notifyEvent(oEvent)
msgbox "event: " & oEvent.EventName
End Sub
Sub add_modifyListener(ByRef Sheet)
Dim ePrefix As String : Dim eService As String
Dim cell as Object
ePrefix = "event_"
eService = "com.sun.star.util.XModifyListener"
cell = Sheet.getCellrangeByName("A2:A9")
If IsNull(mModifyHandler) Then
mModifyHandler = CreateUnoListener(ePrefix, eService)
cell.AddModifyListener(mModifyHandler)
EndIf
End Sub
Sub event_modified(oEvent)
'If oEvent.Source.CellAddress.Column <> 0 Then Exit Sub
Msgbox "changes made"
End Sub
where mEventHandler and mModifyHandler are global
Sub add_autofilter(ByRef Sheet)
On Error GoTo Err
Dim Range As New com.sun.star.table.CellRangeAddress
Dim FilterOn As Boolean, dRange As Object, cell As Object, row%
FilterOn = False
cell = Sheet.getCellRangeByName("A1")
row = getLastRow(Sheet)
On Error Resume Next
dRange = ThisComponent.DatabaseRanges.getByName("Symbols")
FilterOn = dRange.AutoFilter
On Error GoTo 0 : On Error GoTo Err
If FilterOn Then Exit Sub
With Range
.Sheet = 0
.StartColumn = 0
.StartRow = 0
.EndColumn = 0
.EndRow = row
End With
'Range = Sheet.getCellRangeByPosition(0, 0, 0, row)
ThisComponent.DatabaseRanges.addNewByName("Symbols", Range)
ThisComponent.DatabaseRanges.getByName("Symbols").AutoFilter = True
Exit Sub
Err:
End Sub
Function getLastRow(ByRef Sheet) As Integer
Dim cursor
cursor = Sheet.createCursor()
cursor.gotoEndOfUsedArea(false)
getLastRow = cursor.getRangeAddress().EndRow
End Function
While I am waiting for rational solution, I found a workaround - If no autofilter listener will be possible, Ill have to stay with that:
add formula in some cell: (old solution, check EDIT below)
"=IF(NOW()>0;ROWS_FILTERED();0)"
Function ROWS_FILTERED() As Integer
If Freezed Then Exit Function
Dim i%, rows%, Sheet As Object : Sheet = ThisComponent.Sheets(0)
rows = getLastRow(Sheet)
For i = 1 to getLastRow(Sheet) 'row 0 is for labels
If Sheet.Rows(i).IsVisible = True Then
rows = rows - 1
End If
Next i
ROWS_FILTERED = rows
End Function
And if you make changes where computations are not expected, just assign True to Global Freezed for that time
EDIT:
eureka! I have found this shiny formula that works and updating without workaround:
Eureka! Mimo że nie osiągnąłem rezultatu z czystego BASIC'a, znalazłem genialną formułę, która się odnosi bezpośrednio do autofiltra!! i updateuje bez obejścia:
"=SUBTOTAL(3;A2:A" & getLastRow(Sheet) + 1 & ")"
dont forget to include getLastRow(ByRef Sheet) function to your code
I would like to find the best way to have a text box displays a message everytime another control (a button) is pushed. Each time the button is pushed, the message will change and that message should show in my text box. The trick I would like to do is after the user stops pressing the button, that after a certain period (3 seconds) the text box will disappear.. (perhaps the message can be deleted). What is the correct event to use ?
Basically, for each control named 'msgPrincipio' in the code below, i would like that message to appear within the text box for 3 seconds and then disappear:
Private Sub Form_Timer()
Dim intTimerStart As Integer, intTimerUsed As Integer
Dim intCountdown As Integer
On Error GoTo Err_Handle
If Me!msgPrincipio <> "" Then
If intTimerStart > 0 Then
intTimerUsed = CLng((Timer / 60) - intTimerStart)
Else
intTimerStart = CLng(Timer / 60)
End If
If intCountdown > 3 Then
Me!msgPrincipio = ""
End If
intCountdown = intCountdown + 1
End If
Err_Exit: Exit Sub
Err_Handle: Resume Next
End Sub
Dim intTimerStart as Integer, intTimerUsed as Integer
Dim intCountdown as Integer
Sub Form_Timer()
On Error GoTo Err_Handle
If Me!MyBox <> "" Then
If intTimerStart > 0 Then
intTimerUsed = CLng((Timer / 60) - intTimerStart)
Else
intTimerStart = CLng(Timer / 60)
End If
If intCountdown > 3 Then
Me!MyBox = ""
End If
intCountdown = intCountdown + 1
End If
Err_Exit: Exit Sub
Err_Handle: Resume Next
End Sub
You also need to go to the form's design view and set the "Timer Interval" property on the form to an appropriate value. This code assumes 1,000 (1 second).
You almost never want to use Resume Next, but it's good here -- the goal is to pass through this block of code as seamlessly as possible. (Which you can accomplish with simple On Error Resume Next at the start -- but I don't like seeing it in my code that way, not one bit. I do this so I'll easily recognize it's by design, not carelessness.)
New to Access' Form Timer?
Private Sub Form_Timer()
Debug.Print Time ' Update time display.
End Sub
Put this code in the form's VBA module. Return to the form design view and switch to form view. Now go back to VBA and check your Immediate window. You should see evidence the form timer event is kicking. Note the Timer property of the form (found under form properties, design view) must not be blank or zero. It needs an entry to kick.
Using C#
using System.Windows.Forms;
public partial class Form1 : Form
{ private Timer x = new Timer();
public Form1()
{
x.Interval = (6000); //1 second = 1000
x.Tick += new EventHandler(TimerTask);
x.Start();
}
private void TimerTask(object sender, EventArgs e)
{
TextboxName.Text = String.Empty;
}
To set a label content dispear automatically: https://gamespec.tech/how-to-clear-textbox-after-few-seconds-in-c-sharp/#3-set-label-content-and-make-it-disappear-automatically
Info: Excel 2010
Notes: The code works exactly how I need, I am now wanting to automate it a little
I recently came across this code, it's for a custom function, however I can not create a button for it (like a macro), I would like to convert some of this code, however I don't know what to do or how to go about it. I want to have a shortcut/button on my ribbon.
https://stackoverflow.com/a/17337453/2337102
Function listUnique(rng As Range) As Variant
Dim row As Range
Dim elements() As String
Dim elementSize As Integer
Dim newElement As Boolean
Dim i As Integer
Dim distance As Integer
Dim result As String
elementSize = 0
newElement = True
For Each row In rng.Rows
If row.Value <> "" Then
newElement = True
For i = 1 To elementSize Step 1
If elements(i - 1) = row.Value Then
newElement = False
End If
Next i
If newElement Then
elementSize = elementSize + 1
ReDim Preserve elements(elementSize - 1)
elements(elementSize - 1) = row.Value
End If
End If
Next
distance = Range(Application.Caller.Address).row - rng.row
If distance < elementSize Then
result = elements(distance)
listUnique = result
Else
listUnique = ""
End If
End Function
Results with the ability to:
Just enter =listUnique(range) to a cell. The only parameter is range
that is an ordinary Excel range. For example: A$1:A$28 or H$8:H$30.
I would like the following:
Create a macro button with an a popup Inputbox to ask for a range.
Usage:
1) I am in the cell where I require the list to begin (BA9)
2) I click the custom module/macro button & popup box asks me the range (G$8:G$10000)
3) The result then autofills in column (BA)
Lastly, can the code be amended so that the restriction of "The first cell where you call the function must be in the same row where the range starts." be removed so that I can use a reference from another sheet within the same workbook.
I apologise if I should have gone direct to the coder, the thread that it was in is old & I thought given the amount of change I'm asking for it may be better suited in its own question.
Thank you in advance.
First approach: (you can use RemoveDuplicates method instead function listUnique)
Just assign this Sub to your custom button:
Sub testRemoveDuplicates()
Dim targetRange As Range
Dim actCell As Range
Dim res As Variant
Set actCell = ActiveCell
On Error Resume Next
Set targetRange = Application.InputBox("Please highlight the cell for TARGET", Type:=8)
On Error GoTo 0
If targetRange Is Nothing Then
MsgBox "User has pressed cancel"
Exit Sub
End If
targetRange.Copy
actCell.PasteSpecial xlPasteValues
actCell.RemoveDuplicates Columns:=1, Header:=xlNo
Application.CutCopyMode = False
End Sub
Second approach: (if you'd like to use function listUnique)
Here is another listUnique function. You can get list of unique elements usign Dictionary object (it is better suited for your purposes):
Function listUnique(rng As Range) As Variant
Dim row As Range
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
On Error Resume Next
For Each row In rng.Rows
If row.Value <> "" Then
dict.Add row.Value, row.Value
End If
Next
Dim res As Variant
ReDim res(1 To dict.Count)
res = dict.Items
Set dict = Nothing
listUnique = Application.Transpose(res)
End Function
then you can call it using following Sub (you can assign it to custom button):
Sub test()
Dim targetRange As Range
Dim actCell As Range
Dim res As Variant
Set actCell = ActiveCell
On Error Resume Next
Set targetRange = Application.InputBox("Please highlight the cell for TARGET", Type:=8)
On Error GoTo 0
If targetRange Is Nothing Then
MsgBox "User has pressed cancel"
Exit Sub
End If
res = listUnique(targetRange)
actCell.Resize(UBound(res)) = res
End Sub
Note: if you're going to call this listUnique function direct from worksheet (as UDF function), you should select destination range (in example D10:D20), with selected range enter formula =listUnique(A1:A10) in formula bar, and press CTRL+SHIFT+ENTER to evaluate it.
I'm looking to create a function in Excel/VBA that will look at a range of cells and return a value of TRUE if any of the cells contains a certain character (an asterisk *). There will be some blank cells, some cells will contain text and some may contain text and an asterisk. Can anyone help? Many thanks
Copy and paste the below code into a new module
Function ContainsStar(r As Range) as Boolean
Dim i As Long
Dim cell As Range
Dim contains As Boolean
For Each cell In r.Cells
For i = 1 To Len(cell)
If Right(Left(cell, i), 1) = Chr(42) Then
contains = True
GoTo ExitFn
End If
Next i
Next
Exit Function
ExitFn:
ContainsStar = contains
Exit Function
End Function
then use it in the spreadsheet like this
Note:
D1 = =ConstainsStar(A1:A3)
H1 = =ConstainsStar(E1:E3)
you can also use the instr function
function containstar(byval r as range) as boolean
dim cel as range 'be careful about variable names that are already existing code (cell)
for each cel in r.cells
'or use a loop like: for i=1 to r.cells.count , and use r.cells(i), if you prefer.
if instr(1,cel.value,"*")>0 then
containstar=true
exit sub 'you can also exit for
end if
next cel
containstar=false
end sub
and to call the function:
a=containstar("a1:b8")
use only goto when you cannot do else, usually you don't need it.
I have an access 2007 front-end app. On a particular form, there are 2 radio buttons in a radio button group. I am trying to detect when the radio button group is changed and capture the old and new values, but my OldValue and Value properties are = in the save event, even if I have changed it. The OldValue is equal to the New radio button value, not what it was originally.
I tried coding this in the form's Save subroutine. The intent was to compares the RB value with the original dataset value to force setting the old value, but it doesn't like the 'SET' statements
If fraResistOption.Value = 1 And (IsNull([Dl_Resisted]) Or UCase([Dl_Resisted]) = "N") Then
Set fraResistOption.OldValue = 1
[Dl_Resisted] = "N"
Else
If fraResistOption.Value = 1 And (Not IsNull([Dl_Resisted]) Or UCase([Dl_Resisted]) = "Y") Then
Set fraResistOption.OldValue = 2
[Dl_Resisted] = "N"
Else
If fraResistOption.Value = 2 And (IsNull([Dl_Resisted]) Or UCase([Dl_Resisted]) = "N") Then
Set fraResistOption.OldValue = 1
[Dl_Resisted] = "Y"
Else
If fraResistOption.Value = 1 And (Not IsNull([Dl_Resisted]) Or UCase([Dl_Resisted]) = "Y") Then
Set fraResistOption.OldValue = 2
[Dl_Resisted] = "Y"
End If
End If
End If
End If
Could someone suggest a way to do this? Please and thank you.
The .OldValue property of the Option Group (sometimes referred to as "Frame") does work. I have a table named [optValues]:
[ID] - AutoNumber
[optValue] - Numeric (Long Integer)
It contains one record:
ID optValue
1 3
My form's Record Source is the [optValues] table. The form has an Option Group named "Frame0" whose Control Source is the [optValue] field. It contains three Option buttons
label: "foo", value: 1
label: "bar", value: 2
label: "baz", value: 3
The After Update event handler for Frame0 is:
Private Sub Frame0_AfterUpdate()
MsgBox "Old value: " & Me.Frame0.OldValue & ", New value: " & Me.Frame0.Value
End Sub
When I open the form, "baz" is selected (because [optValue] is 3 in the table):
When I click on "foo" I immediately see the (correct) old and new values:
The only way I can think of to detect and capture changes to Option-Group values is to handle the Form_Current event (save the Option Group value), then also handle the Option-Group After event. Although you can change the Option-Group.Value, OldValue is likely a protected (read-only) property. Hope something like the following helps:
Dim OldValue As Byte
Dim CurrentValue As Byte
Private Sub Form_Current()
OldValue = Frame0.Value
End Sub
Private Sub Frame0_AfterUpdate()
CurrentValue = Frame0.Value
Debug.Print "AFTER: OldValue=" & OldValue & "' CurrentValue=" & CurrentValue
End Sub
I don't know why but .oldvalue doesn't work for me.
If you are in the same boat as me, you can use the BeforeUpdate event of the optionGroup and set a static variable.
Then read the static variable in afterUpdate event and reset it for the next change.