UserForm to add from a selected cell from a TextBox value - excel

I am trying to have a UserForm GUI so that we can add and subtract from inventory, I have got it so that I can select a worksheet and a row, but I am having trouble adding and subtracting part. Pretty new to VBA and I am not sure how to call that variable and modify it. Any help would be great!! Here is my code in the UserForm:
Option Explicit
Private Sub BTNadd_Click()
End Sub
Private Sub BTNDone_Click()
'This will save and close the GUI'
ThisWorkbook.Save
StgRmGUI.Hide
End Sub
Private Sub BTNrmv_Click()
End Sub
Private Sub ItmNmSlct_Change()
Dim actItm As String
End Sub
Private Sub ItmTypSlct_Change()
'This allows ItmTypSlct to show available wrkshts then will make item show in Item Name box'
With Worksheets(ItmTypSlct.Value)
ItmNmSlct.RowSource = Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Address(, , , True)
End With
End Sub
Private Sub NumBox_Change()
Dim NewVal As Integer
NewVal = Val(NumBox.Text)
If NewVal >= SpBtnARNum.Min And _
NewVal <= SpBtnARNum.Max Then _
SpBtnARNum.Value = NewVal
End Sub
Private Sub SpBtnARNum_Change()
NumBox.Text = SpBtnARNum.Value
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = xlSheetVisible Then
ItmTypSlct.AddItem ws.Name
End If
Next ws
End Sub

An simple example of updating the column B value by the amount in NumBox
Private Sub BTNadd_Click()
Dim r As Long, cell As Range
With ItmNmSlct
r = .ListIndex
If r < 0 Then Exit Sub
' select quatity cell and increment value
Set cell = Range(.RowSource).Cells(r + 1, 2)
cell.Value = cell.Value + NumBox.Value
End With
End Sub

Related

Preventing Rows from being hidden based on cells not empty

I am needing to prevent a range of rows from being hidden if any of the rows have text in cells in D column.
Private Sub Worksheet_Change(ByVal Target As Range)
Set rRng = Sheet1.Range("D35, D36, D37, D38, D39, D40")
If Target.Row >= 34 And Target.Row <= 40 Then
If IsEmpty("rRng.value") Then
Range("D35:D40").EntireRow.Hidden = False
Else: Range("D35:D40").EntireRow.Hidden = (Range("D34").Value = "")
End If
End If
End Sub
You might need to trigger your hide/unhide from the calculate event too so that any formulas/vba that changes the values also triggers and update. (Im not sure what the intended result is, so the code below isn't a dropin replacement)
Private Sub Worksheet_Calculate()
HideRows
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
HideRows
End Sub
Public Sub HideRows()
Dim R As Range: Set R = Sheet1.Range("D35:D40")
If Excel.WorksheetFunction.CountA(R) > 0 Then
R.EntireRow.Hidden = False
Else
R.EntireRow.Hidden = True
End If
End Sub
Sub SetAValue()
Sheet1.Range("D35").Value = "show"
End Sub

Delete checkbox from a Specific Cell with VBA

I'm putting together a spreadsheet that should populate checkboxes in a specific column when the spreadsheet opens if the appropriate A Column/Row is not empty. It should also remove checkboxes when it finds that same A column to be empty. My VB is correctly creating the checkboxes, but I cannot figure out how to tell the code to delete the checkbox from a specific cell.
Most articles I find mention removed ALL checkboxes, but I'm looking to do it conditionally. Any guidance would be greatly appreciated.
Private Sub Workbook_Open()
'declare a variable
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
'calculate if a cell is not blank across a range of cells with a For Loop
For x = 2 To 1000
If ws.Cells(x, 1) <> "" Then
Call Add_CheckBox(CInt(x))
Else
Call Delete_CheckBox(CInt(x))
End If
Next x
End Sub
Private Sub Add_CheckBox(Row As Integer)
ActiveSheet.CheckBoxes.Add(Cells(Row, "T").Left, Cells(Row, "T").Top, 72, 12.75).Select
With Selection
.Caption = ""
.Value = xlOff '
.LinkedCell = "AA" & Row
.Display3DShading = False
End With
End Sub
Private Sub Delete_CheckBox(Row As Integer)
Dim cb As CheckBox
If cb.TopLeftCell.Address = (Row, "T") Then cb.Delete
End Sub
Naming the CheckBoxes will make it easier to maintain your code.
Private Sub Workbook_Open()
Const CheckBoxPrefix As String = "Sheet1TColumnCheckBox"
'declare a variable
Dim CheckBoxName As String
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
'calculate if a cell is not blank across a range of cells with a For Loop
Dim r As Long
For r = 2 To 1000
CheckBoxName = CheckBoxPrefix & r
If Len(ws.Cells(r, 1)) > 0 Then
If Not WorksheetContainsCheckBox(CheckBoxName, ws) Then Add_CheckBox CheckBoxName, ws.Cells(r, 1), ws.Cells(r, "AA")
Else
If WorksheetContainsCheckBox(CheckBoxName, ws) Then ws.CheckBoxes(CheckBoxName).Delete
End If
Next
End Sub
Private Sub Add_CheckBox(CheckBoxName As String, Cell As Range, LinkedCell As Range)
With Cell.Worksheet.CheckBoxes.Add(Cell.Left, Cell.Top, 72, 12.75)
.Caption = ""
.Value = xlOff '
.LinkedCell = LinkedCell
.Display3DShading = False
.Name = CheckBoxName
End With
End Sub
Function WorksheetContainsCheckBox(CheckBoxName As String, ws As Worksheet)
Dim CheckBox As Object
On Error Resume Next
Set CheckBox = ws.CheckBoxes(CheckBoxName)
WorksheetContainsCheckBox = Err.Number = 0
On Error GoTo 0
End Function
Try something like this (put a checkbox "in" A1 but not C1)
Sub tester()
Debug.Print Delete_CheckBox([A1])
Debug.Print Delete_CheckBox([C1])
End Sub
'Return True if able to delete a checkbox from range `rng`
Private Function Delete_CheckBox(rng As Range) As Boolean
Dim cb As CheckBox
For Each cb In rng.Worksheet.CheckBoxes
If Not Application.Intersect(cb.TopLeftCell, rng) Is Nothing Then
Debug.Print "Deleting checkbox in " & cb.TopLeftCell.Address
cb.Delete
Delete_CheckBox = True
Exit For 'if only expecting one matched checkbox
End If
Next cb
End Function

Command button for multiple sheets

I have 3 sheets. On every sheet is command button.
I want on one sheet to take action on other two.
Can You give me some tips what should I do? Thanks.
Private Sub CommandButton1_Click()
Dim cell As Range
For Each cell In Range("J9:J137")
If Not IsEmpty(cell) Then
If cell.Value = 0 Then
cell.EntireRow.Hidden = False
End If
End If
Next
End Sub
Private Sub CommandButton2_Click()
Dim cell As Range
For Each cell In Range("J9:J137")
If Not IsEmpty(cell) Then
If cell.Value = 0 Then
cell.EntireRow.Hidden = True
End If
End If
Next
End Sub
Think I found solution:
Option Explicit
Sub Button8_Click()
Dim xSh As Worksheet
Application.ScreenUpdating = False
For Each xSh In Worksheets
xSh.Select
Call CommandButton2_Click
Next
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton1_Click()
Dim cell As Range
For Each cell In Range("J9:J137")
If cell.Value = 0 Then
cell.EntireRow.Hidden = False
End If
Next
End Sub
Private Sub CommandButton2_Click()
Dim cell As Range
For Each cell In Range("J9:J137")
If cell.Value = 0 Then
cell.EntireRow.Hidden = True
End If
Next
End Sub
If You got 3 sheets: Sheet1, Sheet2, Sheet3 and on the first You got a button, which is calling button actions on other 2 sheets assign below code to the button on Sheet1:
Sub ButtonOnFirstSheet()
Call CommandButton1_Click
Call CommandButton2_Click
End Sub
and would like to modify a little bit your code to be sure it will appeal to correct sheet:
Private Sub CommandButton1_Click()
Dim cell As Range
With Sheets("Sheet2")
For Each cell In .Range("J9:J137")
If Not IsEmpty(cell) Then
If cell.Value = 0 Then
cell.EntireRow.Hidden = False
End If
End If
Next
End With
End Sub
Private Sub CommandButton2_Click()
Dim cell As Range
With Sheets("Sheet3")
For Each cell In .Range("J9:J137")
If Not IsEmpty(cell) Then
If cell.Value = 0 Then
cell.EntireRow.Hidden = True
End If
End If
Next
End With
End Sub

Clear userform sub giving 1004 error due to dynamic combobox

I am working on a customer complaint database. I want to implement a userform for data entry.
I have a button to clear the userform. It clears the entire form except for ComboBox2 that has results which are dependent on the selection from ComboBox1.
I get a 1004 run-time error based which calls back to the Match function I've used for ComboBox2.
Private Sub CommandButton2_Click()
Clear_Form
End Sub
Sub Clear_Form()
Me.ComboBox2.Clear
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.Text = ""
Case "ComboBox"
ctl.ListIndex = -1
End Select
Next ctl
End Sub
Private Sub UserForm_Activate()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Customer")
Dim i As Integer
Me.ComboBox1.Clear
For i = 1 To Application.WorksheetFunction.CountA(sh.Range("1:1"))
Me.ComboBox1.AddItem sh.Cells(1, i).Value
Next i
End Sub
Private Sub ComboBox1_Change()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Customer")
Dim i As Integer
Dim n As Integer
n = Application.WorksheetFunction.Match(Me.ComboBox1.Value, sh.Range("1:1"), 0)
Me.ComboBox2.Clear
For i = 2 To Application.WorksheetFunction.CountA(sh.Cells(1, n).EntireColumn)
Me.ComboBox2.AddItem sh.Cells(i, n).Value
Next i
End Sub
You will get an error because Clear_Form clears the combobox which in turn calls the _Change event and the Match fails because there is no value in combobox. Simply add one line to the _Change event.
Private Sub ComboBox1_Change()
If ComboBox1.ListIndex = -1 Then Exit Sub '<~~ ADD THIS
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Customer")
Dim i As Integer
Dim n As Integer
n = Application.WorksheetFunction.Match(Me.ComboBox1.Value, sh.Range("1:1"), 0)
Me.ComboBox2.Clear
For i = 2 To Application.WorksheetFunction.CountA(sh.Cells(1, n).EntireColumn)
Me.ComboBox2.AddItem sh.Cells(i, n).Value
Next i
End Sub

Limit macro to set a range for textbox

I am trying to link a range of cells to a text box, the only problem is if I edit the text box, it will write in any cell. I want to limit that ability to a specific range ("C4 to C11"). Here is my code:
Dim PreviousCell As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 3 Then ActiveSheet.TextBox1.Text = Target
If Not PreviousCell Is Nothing Then
Debug.Print PreviousCell.Address
End If
Set PreviousCell = Target ' This needs to be the last line of code.
End Sub
Private Sub TextBox1_Change()
ActiveCell.Value = TextBox1
End Sub
Private Sub TextBox1_Change()
If ActiveCell.Column = 3 Then ActiveCell.Value = TextBox1
End Sub

Resources