Trying to create an inputbox that a user can type notes into, those notes will be input onto the same document and simultaneously create a macro enables “thumbs up icon” that will hold a macro that other members can “thumbs up” ideas they want to promote. The code below is causing the button to duplicate itself on the same cell. I need it to instead apply to the next available cell.
Sub VBA_Input_Idea_inputbox()
Dim MyInp As String
Dim NextRow As Long
MyInp = VBA.Interaction.InputBox("Please input idea", "LEARNING
REQUEST")
If MyInp = "" Then Exit Sub
NextRow = Cells(Rows.Count, 3).End(xlUp).Row + 1
Range("C" & NextRow).Value =
Excel.WorksheetFunction.Proper(MyInp)
Range("A" & NextRow).Select
ActiveSheet.Buttons.Add(0.75, 145.5, 42, 24.75).Select
Selection.OnAction = "Addcount"
End Sub
Something like this:
Sub VBA_Input_Idea_inputbox()
Dim MyInp As String
Dim NextRow As Range, btn
MyInp = VBA.Interaction.InputBox("Please input idea", "LEARNING REQUEST ")
If MyInp = "" Then Exit Sub
With ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).EntireRow
.Cells(3).Value = Application.Proper(MyInp)
Set btn = ActiveSheet.Buttons.Add(.Cells(1).Left, .Cells(1).Top, _
.Cells(1).Width, .Cells(1).Height)
btn.OnAction = "Addcount"
End With
End Sub
Related
I have a dropdown that before was being populated with values from a second sheet in my workbook using the following code:
Private Sub UserForm_Initialize()
Dim cProd As Range
Dim ws As Worksheet
Dim i As Long
Set ws = ThisWorkbook.Worksheets("DO NOT DELETE")
For Each cProd In ws.Range("ProdList")
With Me.dropProd
.AddItem cProd.Value
End With
Next cProd
Me.dropProd.SetFocus
End Sub
Then, I added the code I found here to add the searchable functionality to it, and it was working just fine.
Then I had to tweak my code to add a second dropdown that would be dependent on the first one that I had previously. To do that, I deleted that DO NOT DELETE worksheet, and created two collections to store the values for the dropdowns.
Now, my first dropdown is being populated in this code:
Sub UpdateAll()
Dim ProdID As String
Dim Prod As String
Dim TF As Boolean
Dim lRow As Long
Dim i, t, s
dropProd.Clear
dropPromo.Clear
Set ws = ThisWorkbook.Worksheets("Table View")
Set cProd = New Collection
lRow = ws.Cells(Rows.Count, 1).End(-4162).Row
For i = 13 To lRow
ProdID = ws.Cells(i, 2).Value
Prod = ws.Cells(i, 3).Value
If ProdID <> "" Then
TF = False
If cProd.Count <> 0 Then
For t = 1 To cProd.Count
If cProd(t) = ProdID & " - " & Prod Then TF = True
Next
End If
If TF = False Then cProd.Add (ProdID & " - " & Prod)
End If
Next
For s = 1 To cProd.Count
dropProd.AddItem (cProd(s))
Next
End Sub
Private Sub UserForm_Initialize()
Me.dropProd.SetFocus
UpdateAll
End Sub
This part is also doing great, the below is where I'm having trouble with:
Private Sub dropProd_Change()
Dim ProdInfo As String
Dim Promo As String
Dim q, p
dropPromo.Clear
lRow = ws.Cells(Rows.Count, 1).End(-4162).Row
If dropProd.Value <> "" Then
ProdInfo = Mid(dropProd.Value, 1, InStr(1, dropProd.Value, " - ") - 1)
End If
'Populates Promo ComboBox
For q = 13 To lRow
Promo = ws.Cells(q, 9).Value
If ws.Cells(q, 2).Value = ProdInfo Then dropPromo.AddItem Promo
Next
End Sub
The above works fine if I just select the value from the dropdown, but it breaks every time I try to search anything, and the problem is in this line ProdInfo = Mid(dropProd.Value, 1, InStr(1, dropProd.Value, " - ") - 1)
I've tried to rewrite it in another way, but it's still throwing me an error. Also, I tried to incorporate the code from the link above to see if it would work, but then I didn't know what to reference on me.dropProd.List = ????. I've tried haing this equals to the Collection I have, and of course it didn't work, and now I'm stuck on how to fix it.
I couldn't reproduce the problem with your code line ProdInfo = Mid(dropProd.Value, 1, InStr(1, dropProd.Value, " - ") - 1), it might be data related. Try this alternative ProdInfo = Trim(Split(dropProd.Value, "-")(0)) and a dictionary rather than a collection.
Option Explicit
Dim ws
Sub UpdateAll()
Dim ProdID As String, Prod As String
Dim lastrow As Long, i As Long
dropProd.Clear
dropPromo.Clear
Dim dictProd As Object, k As String
Set dictProd = CreateObject("Scripting.DIctionary")
Set ws = ThisWorkbook.Worksheets("Table View")
With ws
lastrow = ws.Cells(.Rows.Count, 1).End(xlUp).Row
For i = 13 To lastrow
ProdID = Trim(.Cells(i, 2))
If Len(ProdID) > 0 Then
Prod = Trim(.Cells(i, 3))
k = ProdID & " - " & Prod
If Not dictProd.exists(k) Then
dictProd.Add k, 1
End If
End If
Next
dropProd.List = dictProd.keys
End With
End Sub
Private Sub dropProd_Change()
Dim ProdInfo As String, Promo As String
Dim lastrow As Long, i As Long
dropPromo.Clear
If dropProd.Value <> "" Then
ProdInfo = Trim(Split(dropProd.Value, "-")(0))
'Populates Promo ComboBox
With ws
lastrow = ws.Cells(.Rows.Count, 1).End(xlUp).Row
For i = 13 To lastrow
If .Cells(i, 2).Value = ProdInfo Then
Promo = ws.Cells(i, 9).Value
dropPromo.AddItem Promo
End If
Next
End With
End If
End Sub
Private Sub UserForm_Initialize()
Me.dropProd.SetFocus
UpdateAll
End Sub
I am trying to create a counter that displays how many times a macro enabled button is clicked. I'm having trouble identifying the active cell associated with macro enabled button. It will be anywhere from cell A9 through A50 (I will have multiple macro buttons that will apply on the page).
Code needs to look at cell directly to the right of the active cell and add 1 to that number when a button is pushed. I'm new to VBA and not having success at applying the suggested questions to my scenario.
Here is how the button is being placed onto the sheet if it is helpful in resolving the problem.
Sub VBA_Input_Idea_inputbox()
Dim MyInp As String
Dim NextRow As Long
Dim Counter As Long
Dim btn As Button
Dim t As Range
Counter = Counter + 1
MyInp = VBA.Interaction.InputBox("Please input idea", "LEARNING REQUEST")
If MyInp = "" Then Exit Sub
NextRow = Cells(Rows.Count, 3).End(xlUp).row + 1
Range("C" & NextRow).Value = Excel.WorksheetFunction.Proper(MyInp)
Set t = ActiveSheet.Range("A" & NextRow)
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "VBA_Love_It_msgbox3"
.Caption = "Vote for this Idea!"
.Name = "btn" & "Love This"
End With
Range("B" & NextRow) = Counter
End Sub
In the macro attached to the button, Application.Caller will give you the name of the button/shape calling the code:
Sub VBA_Love_It_msgbox3()
With ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, 1)
.Value = .Value + 1
End With
End Sub
EDIT: for this to work you need to ensure your buttons all have different names.
I have just started learning VBA (and coding in general) and I am faced with a problem to which I have not yet found a solution. I'd like to create an input box with a loop so that the output from the input box will be printed to separate cell. For example, I would like to write number "5" to the input box and the output will be printed to Cell "A1" and the next input, say number "9", will be printed to Cell "A2".
So far, I have managed to this and everything works fine except the last row as I don't know how to continue from here.
Private Sub CommandButton1_Click()
Dim myValue As Variant
myValue = InputBox("Please insert number")
Range("A1").Select
ActiveCell.Value = myValue
Range(ActiveCell) = Range(ActiveCell) + 1
End Sub
All help is appreciated
Try with below code
Private Sub CommandButton1_Click()
Dim myValue As Variant
myValue = InputBox("Please insert number")
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = myValue
End Sub
EDIT #1:
Updated the code as per the advice of user3598756
Private Sub CommandButton1_Click()
Dim myValue As Variant
myValue = InputBox("Please insert number")
If Range("A" & Range("A" & Rows.Count).End(xlUp).Row).Value = "" Then
Range("A" & Range("A" & Rows.Count).End(xlUp).Row) = myValue
Else
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = myValue
End If
End Sub
edited to
shorten the code
add solution should cell "A1" be already filled with header
the following code will do:
Sub CommandButton1_Click()
With Cells(Rows.Count, 1).End(xlUp)
.Offset(IIf(.Value <> "", 1, 0)) = InputBox("Please insert number")
End With
End Sub
where the "conditional" offset is necessary to manage the first empty cell being in row 1 (no offset) or lower (1 row offset)
should cell "A1" be already filled with header, the code shortens down to:
Sub CommandButton1_Click()
Cells(Rows.Count, 1).End(xlUp).Offset(1) = InputBox("Please insert number")
End Sub
If you want to do a loop - for example 10 times - then you can use this example code:
Sub CommandButton1_Click()
Dim counter As Integer
Dim myValue As Variant
For counter = 1 To 10
myValue = InputBox("Please insert number")
Sheets("Sheet1").Cells(counter, 1).Value = myValue
Next counter
End Sub
I'm pretty new at VBA so I'm sure I'm missing something easy... I am getting a compile error "Loop without Do"
The function being called GrabDataFromMinutes I have tested successfully on it's own. Any help is appreciated, Thanks!
Public Sub CopyAllData()
Dim Location As String
Location = ActiveCell.Address
Dim CellValue As String
CellValue = ActiveCell.Value
Do
If IsEmpty(CellValue) = True Then 'If cell is empty skip row'
ActiveCell.Offset(rowOffset:=1, ColumnOffset:=-1).Activate
Loop
If Location <> "C350" Then 'run the command unless EOF'
Application.Run ("GrabDataFromMinutes")
MsgBox "I got here"
Location = ActiveCell.Address
Loop
End If
Exit Do
End Sub
As rightly mentioned by Scott you need to place the LOOP statement in the respective place. Click Here
Your code should be like this
Public Sub CopyAllData()
Dim Location As String
Location = ActiveCell.Address
Dim CellValue As String
CellValue = ActiveCell.Value
Do
If IsEmpty(CellValue) = True Then 'If cell is empty skip row'
ActiveCell.Offset(rowOffset:=1, ColumnOffset:=-1).Activate
If Location <> "C350" Then 'run the command unless EOF'
Application.Run ("GrabDataFromMinutes")
MsgBox "I got here"
Location = ActiveCell.Address
End If
End If
Loop
End Sub
This is the end solution to my own problem. The information provided by other answers contributed to fixing my problems. Thanks Everyone!
Public Sub CopyAllData()
'Declarations'
Dim CellValue As String
Dim LastRow As Integer
Dim CurrentRow As Integer
Application.Run ("CopyMinuteHeaders") 'Copy Headers and setup sheet'
'Initialize values'
CellValue = ActiveCell.Value
CurrentRow = ActiveCell.Row
LastRow = ActiveSheet.UsedRange.Rows.Count
LastRow = LastRow + 1
Do While LastRow <> CurrentRow
If CurrentRow >= LastRow Then
Exit Sub
End If
If CellValue = "" Then 'If cell is empty skip row'
Do While CellValue = "" 'Skip multiple rows that are empty'
ActiveCell.Offset(rowOffset:=1, ColumnOffset:=0).Activate
CellValue = ActiveCell.Value
Loop
End If
If CurrentRow <> LastRow Then
Application.Run ("GrabDataFromMinutes")
CurrentRow = ActiveCell.Row
CellValue = ActiveCell.Value
End If
Loop
End Sub
I don't know what your GrabDataFromMinutes macro does, I would assume it deals with the active cell though. Usually I would try not to supply a code using select or activate. If you were to supply the code for GrabDataFromMinutes maybe a better solution could be found for you.
In the meantime practice with this code, it will select only the non-blank cells in column A and call the otherMacro.
Sub LoopNonBlanks()
Dim Lstrw As Long
Dim Rng As Range
Dim c As Range
Lstrw = Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range("A2:A" & Lstrw).SpecialCells(xlCellTypeConstants, 23)
For Each c In Rng.Cells
c.Select
otherMacro 'calls the otherMacro
Next c
End Sub
Sub otherMacro()
MsgBox "This is the other macro " & ActiveCell.Address & " value is ..." & ActiveCell.Value
End Sub
I want to create a macro, that inputs a string into the next available cell, in a defined row. So when the next available cell is found, a inputbox appears, the user types in the data, and then the data goes into the active cell.
I currently have this:
Sub Find_Blank_Row()
Dim QtyInput As String
Dim BlankRow As Long
BlankRow = Range("A65536").End(xlUp).Row + 1
Cells(BlankRow, 1).Select
QtyInput = InputBox("please Enter Company Name")
ActiveRow.Font.Bold = True
ActiveSheet.Range("ActiveCell").Value = QtyEntry
End Sub
How do I make this work?
Thanks in advance.
You don't need to Select to place the value:
Sub Find_Blank_Row()
Dim QtyInput As String
QtyInput = InputBox("please Enter Company Name")
With Cells(Rows.Count, 1).End(xlUp).Offset(1,0)
.Font.Bold = True
.Value = QtyEntry
End With
End Sub
The answerL
Sub Find_Blank_Row()
Dim QtyInput As String
Dim BlankRow As Long
BlankRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
QtyInput = InputBox("Please Enter Company Name")
Cells(BlankRow, 1).Font.Bold = True
Cells(BlankRow, 1).Value = QtyInput
End Sub
The ActiveCell is an object itself always defined at run-time, not the name of a Range object. You should replace this:
ActiveSheet.Range("ActiveCell").Value = QtyEntry
with this
ActiveCell.Value = QtyEntry '<-- ActiveCell is an object pointed through the variable "ActiveCell"