PDA

View Full Version : Create button with different Find range



bull699
11-10-2015, 09:23 AM
Using this to create a button:-

Sub CreateButton4()
Dim i&
With ActiveSheet
i = .Shapes.Count
With .Buttons.Add(199.5, 20 + 46 * i, 81, 36)
.Name = "New Button" & Format(i, "00")
.OnAction = "MoveValue"
.Characters.Text = "Submit " & Format(i, "00")
End With
End With

That runs the MoveValue sub:-

Sub MoveValue()
With Sheets("Sheet1").Columns(8).Find(Range("C3").Value, , , 1).Offset(0, 1)
.Value = .Value + Sheets("Sheet1").Range("D3").Value
End With

The problem is I want MoveValue() to relate to the cells adjacent to it as I have another sub which submits data to the adjacent cells when the button is created (at the moment I've only written it to work for the first button). Not sure if I'm going about this completely the wrong way. Any help would be appreciated.

14730

Thanks in advance

mikerickson
11-10-2015, 04:06 PM
You are going to end up with way too many buttons.
A DoubleClick event might serve you better.
If you put this in the code module for Sheet1, double clicking on any of the filled cells in column C will add the value in D to the others on the right.


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim MatchingCell As Range

With Target
If .Column = 3 And .Value <> vbNullString Then
Cancel = True
Set MatchingCell = Me.Range("H:H").Find(what:=.Value, LookIn:=xlValues, MatchCase:=False)
If Not MatchingCell Is Nothing Then
With MatchingCell.Offset(0, 1)
.Value = Val(CStr(.Value) + Val(CStr(Target.Offset(0, 1).Value)))
Beep
End With
End If
End If

End With
End Sub