Mandatory Row of cells in an Excel Table - excel

I am trying to make a row in my Excel table mandatory before users close the document, then display a pop-up message stating "cells require input".
I am running into an issue where users are still getting the pop-up message even if they have filled out all the mandatory cells.
This is a screenshot of what all I typed out. I have this in the workbook area
I am typing what's in the screenshot, in the workbook area, and have it to run beforeclose.
This is the what I used below. My required fields is the row A3-O3
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Cells(3, 1)(3, 2)(3, 3)(3, 4)(3, 5)(3, 6)(3, 7)(3, 8)(3, 9)(3, 10)(3, 11)(3, 12)(3, 13)(3, 14)(3, 15).Value = "" Then
MsgBox "Cell(s) require input", vbInformation, "Kutools for Excel"
Cancel = True
End If
End Sub
view of my spreadsheet
A plus would be a pop-up message letting the user know which cells are empty & for it to highlight the cells that are empty also

Use WorksheetFunction.CountBlank:
If Worksheetfunction.CountBlank(ActiveSheet.Range("A3:O3")) > 0 Then
MsgBox "Cell(s) require input", vbInformation
End If
Or SpecialCells(xlCellTypeBlanks):
On Error Resume Next
Dim rng As Range
Set rng = ActiveSheet.Range("A3:O3").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rng Is Nothing Then
MsgBox "Cell(s) " & rng.Address(False, False) & " require input", vbInformation
End If
Note that Cells(3, 1)(3, 2)(3, 3)(3, 4)(3, 5)(3, 6)(3, 7)(3, 8)(3, 9)(3, 10)(3, 11)(3, 12)(3, 13)(3, 14)(3, 15) does not refer to A3:O3.
In the Immediate Window, put:
? Cells(3, 1)(3, 2)(3, 3)(3, 4)(3, 5)(3, 6)(3, 7)(3, 8)(3, 9)(3, 10)(3, 11)(3, 12)(3, 13)(3, 14)(3, 15).Address
The result is
$DB$31

Related

compare input Activex TextBox value from user with a range

I have an ActiveX TextBox named txtNewPeymankar and a command button named cmdAdd. I want when user type a string in txtNewPeymankar in my form and click Add button, that value compare with column one of Table1 (Table1[column1]) in DATA sheet and if match with any of cells, show error massage "duplicated value!. please try again." and if not match, save it in the end of column1.
I write this code but not work.
Private Sub cmdAdd_Click()
Dim iRow1 As Long
iRow1 = Sheets("DATA").Range("A1048576").End(xlUp).Row + 1
If Application.Match(txtNewPeymankar.Text, Range(Table1[column1]), 0) Then
MsgBox "duplicated value!. please try again.", vbOKOnly + vbInformation
Else
With ThisWorkbook.Sheets("DATA")
.Range("A" & iRow1).Value = txtNewPeymankar.Value
End With
End If
End Sub

Delete Worksheets based on Checkbox

I am currently trying to write a piece of code where someone is able to use a checkbox to choose which worksheets they would like to keep and what they would like removed. Here is what that looks like:
(currently debating if I should turn this into a userform but i would still be stuck at this point).
What I would like to do is if the checkbox is unchecked (false) on the worksheet called "Setup", delete the worksheet and move onto the next if statement. From the code below, I am prompt with the run-time error '1004': Unable to get the OLEObjects property of the worksheet class. I have checked and the Checkbox name is the same as what I have in my code.
Sub DeleteSheetCB()
If ThisWorkbook.Worksheets("Setup").OLEObjects("CheckBox1") = False Then
ThisWorkbook.Worksheets("Program Information").Delete
End If
If ThisWorkbook.Worksheets("Setup").OLEObjects("CheckBox2") = False Then
ThisWorkbook.Worksheets("Spend and Trx Data").Delete
End If
If ThisWorkbook.Worksheets("Setup").OLEObjects("CheckBox3") = False Then
ThisWorkbook.Worksheets("Requirements").Delete
End If
If ThisWorkbook.Worksheets("Setup").OLEObjects("CheckBox4") = False Then
ThisWorkbook.Worksheets("TMC Overview").Delete
End If
End Sub
Thank you in advance
EDIT:
I was able to get this piece of code to delete sheets but if possible, would someone be able to sense check this for me please?
Sub DeleteSheetCB()
If ThisWorkbook.Worksheets("Setup").Shapes("Check Box 1").ControlFormat.Value <> 1 Then
ThisWorkbook.Worksheets("Program Information").Delete
Else: End If
If ThisWorkbook.Worksheets("Setup").Shapes("Check Box 2").ControlFormat.Value <> 1 Then
ThisWorkbook.Worksheets("Spend and Trx Data").Delete
Else: End If
If ThisWorkbook.Worksheets("Setup").Shapes("Check Box 3").ControlFormat.Value <> 1 Then
ThisWorkbook.Worksheets("Requirements").Delete
Else: End If
If ThisWorkbook.Worksheets("Setup").Shapes("Check Box 4").ControlFormat.Value <> 1 Then
ThisWorkbook.Worksheets("TMC Overview").Delete
Else: End If
End Sub
The main thing I'd take from your second code is:
It will give you a warning before it deletes each sheet
You'll get a subscript out of range error if the sheet has already been deleted.
You have to update your code if you add a new tick box.
The code below assumes the caption of the checkbox is exactly the same as the name of the sheet to be deleted.
Sub DeleteSheetCB()
Dim chkBox As CheckBox
Dim sMissing As String
With ThisWorkbook.Worksheets("Setup")
For Each chkBox In .CheckBoxes 'Look at all checkboxes in Setup sheet.
If chkBox.Value = 1 Then 'If it's ticked.
If WorksheetExists(chkBox.Caption) Then 'Check worksheet exists.
Application.DisplayAlerts = False 'Turn off warnings about deleting a sheet.
ThisWorkbook.Worksheets(chkBox.Caption).Delete
Application.DisplayAlerts = True 'Turn on warnings about deleting a sheet.
Else
sMissing = sMissing & "- " & chkBox.Caption & vbCr
End If
End If
Next chkBox
End With
If sMissing <> "" Then
MsgBox "These sheet(s) could not be deleted as they were already missing: " & vbCr & vbCr & sMissing
End If
End Sub
Public Function WorksheetExists(SheetName As String) As Boolean
Dim wrkSht As Worksheet
On Error Resume Next
Set wrkSht = ThisWorkbook.Worksheets(SheetName) 'Try and set a reference to the sheet.
WorksheetExists = (Err.Number = 0) 'Was an error thrown?
On Error GoTo 0
End Function
Might also be worth mentioning that you can rename your checkboxes:
Select a check box so the Shape Format ribbon becomes visible.
Click Selection Pane under the Arrange section.
A sidebar will appear showing the shapes on the sheet. You can rename or change their visibility here.
chkRemoveProgramInfo makes more sense than Check Box 1.

Compile Error when using different VBA codes in same window

I have a number of things I want to achieve using VBA on a particular sheet.
1) Have a 3 button message box pop up when a certain condition is met.
2) Display the active cell address in a specific cell.
3) When hitting Enter after inputting data only to empty cells in a particular column, make the cursor jump to another column on the same row.
(Codes for each of these are at the end of the post)
I have the code to do all three of these things and they all work fine on their own, indeed the codes for items 1 & 2 also both work fine together, but when I add the code for item 3, a message box appears with
"Compile Error:
Ambiguous name detected: Worksheet_SelectionChange"
and the offending article in the code window is also highlighted.
I've noticed that the code for items 2 & 3 have the heading "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
If I remove the code for item 2, im then faced with a different message box
"Compile Error: Only comments may appear after End Sub, End Function, or End Property"
and highlights the words "Option Explicit" in the code window.
This also seems to break the code for item 1 as well.
I suspect the fact that I have two sets of code in the same window with the same "heading" might be the issue here. Is there a way for me to "blend" them so that they'll all play nicely with each other?
**---CODE FOR ITEM 1---**
Private Sub Worksheet_Calculate()
Dim r As Range
For Each r In Range("L:L")
If r.Value < 0 Then
result = MsgBox("You do not have enough stock to fulfil this request" & vbNewLine & vbNewLine & vbNewLine & _
"Please click: -" & vbNewLine & vbNewLine & _
" -Abort to order more stock" & vbNewLine & _
" -Retry to enter a different value" & vbNewLine & _
" -Ignore to receive stock", _
_
vbAbortRetryIgnore + vbDefaultButton2 + vbExclamation, "Negative Stock Level Warning")
End If
Next r
If result = vbAbort Then
MsgBox "Opening web browser", vbOKOnly + vbInformation, "New program warning!"
ActiveWorkbook.FollowHyperlink _
Address:="https://uk.rs-online.com/login", _
NewWindow:=True
End If
If result = vbRetry Then
MsgBox "Please enter a smaller parts count value", vbOKOnly + vbInformation, "Parts Count Input"
ActiveCell.Offset(-1, 0).Select
End If
If result = vbIgnore Then
MsgBox "You will now be directed to the Goods In window", vbOKOnly + vbInformation, "Receive Stock"
Sheets("Goods In").Activate
End If
End Sub
---CODE FOR ITEM 2---
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("A1048575") = ActiveCell.Address
End Sub
---CODE FOR ITEM 3---
Option Explicit
Dim emptyCell As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub ' don't bother with multicell selections
If Cells(1, Target.Column).Value <> "S.I.#" Then Exit Sub ' don't bother with selections outside "S.I.#" column
If emptyCell And Not IsEmpty(Target.Value) Then Cells(Target.Row, Range("A1", Cells(1, Columns.Count).End(xlToLeft)).Find(what:="Count", _
LookIn:=xlValues, lookat:=xlWhole).Column).Select ' if current cell was empty and now it is not then skip to "Count" column same row
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
emptyCell = IsEmpty(Target.Value) ' store the info about current selection being empty
End Sub

Excel VB Code with Input Box to select a range, when nothing is selected it generates and error

Let me start with the fact that I am NOT a programmer. I am self taught some VB with Excel and MS Access. I know just enough to be dangerous.
I have the following code to prompt the user to select a range. The Input box has an OK and Cancel button. If you do not select any cells and hit the OK or select Cancel it generates an errors.
Private Sub Copy_St5_50_Ramp_Click()
Dim sCell As Range
Set sCell = Application.InputBox("Select the Column of data below that is valid Ramp Data STARTING With 24 Minutes!!!", "Station 5", Type:=8)
If sCell Is Nothing Then Exit Sub
If sCell.Cells.Count < 2 Then Application.InputBox ("You Did not Select Enough Cells"), ("ERROR"), vbOK
sCell.Copy
Worksheets("50 Ramp Data").Range("CJ13").PasteSpecial Paste:=xlPasteValues
'Clear Clipboard (removes "marching ants" around your original data set)
Application.CutCopyMode = False
Worksheets("50 Ramp Data").Range("L4").Select
End Sub
I need it to not error but just close the input box and maybe prompt with a message box as to what went wrong
I've added 2 events to trap the possible errors:
If the user hits cancel >> On Error Resume Next , and later check If Err.Number <> 0 Then.
If the user didn't select any cell, use another parameter in the Application.InputBox of Default:=Selection.Address. So you compare if the Selection.Address after the InputBox is the same as the Selection.Address before the InputBox. If it is, then no new selection was made >> abort the operation.
Code
Option Explicit
Private Sub Copy_St5_50_Ramp_Click()
Dim sCell As Range
Dim CurrentSelectionRng As String
CurrentSelectionRng = Selection.Address
On Error Resume Next
Set sCell = Application.InputBox(prompt:="Select the Column of data below that is valid Ramp Data STARTING With 24 Minutes!!!", Title:="Station 5", Default:=Selection.Address, Type:=8)
' trap a case when the user selectes "Cancel"
If Err.Number <> 0 Then
MsgBox "You chose cancel !", vbCritical
Exit Sub
End If
' if the user didn't select anything (but the cell curser stayed on previous selection)
If sCell.Address = CurrentSelectionRng Then
MsgBox "No cell was selected !", vbCritical
Exit Sub
End If
If sCell Is Nothing Then Exit Sub
If sCell.Cells.Count < 2 Then Application.InputBox ("You Did not Select Enough Cells"), ("ERROR"), vbOK
sCell.Copy
Worksheets("50 Ramp Data").Range("CJ13").PasteSpecial xlPasteValues
'Clear Clipboard (removes "marching ants" around your original data set)
Application.CutCopyMode = False
Worksheets("50 Ramp Data").Range("L4").Select
End Sub

VBA code to refresh format as table filter in Excel

I have a format of table which is with filters and I made the filter to filter all the table based on the cells in column D3 that with value not blank. Now I am trying to make the filter work automatically based on any change on the list on cell G1.
I tried to use the pivot table but this did not work, as this type of table is not part of pivot table (formatted as table).
What is the correct code that can be used for such sorting?
The sheet is Sheet 1, the table named (PT).
The following code will be activated only if the value in G1 is changed.
Open VBE using Alt+F11, open "Sheet 1" module and paste the given code.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errH
If Not Intersect(Target, Me.Range("G1")) Is Nothing Then
Application.EnableEvents = False
'Put here things that you want to be done if G1 value is changed
'For example:
MsgBox "G1 was changed."
Application.EnableEvents = True
End If
Exit Sub
errH:
MsgBox ("Error number: " & Err.Number & ". Description: " & Err.Description)
Application.EnableEvents = True
End Sub
You can test it - just change the G1 value and you will see that it works.
However, I do not understand your explanation about what you want to filter. But whatever it is, just put the code in the place which I identified and remove that MsgBox.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim criteriaparameter As String
Dim criteriavalue As String
On Error GoTo errH
If Not Intersect(Target, Me.Range("G1")) Is Nothing Then
Application.EnableEvents = False
criteriaparameter = ActiveSheet.Range("J1").Value
criteriavalue = ">=" & criteriaparameter
ActiveSheet.Range("$A$8:$L$8").AutoFilter Field:=10, Criteria1:=criteriavalue, _
Operator:=xlAnd
Application.EnableEvents = True
End If
Exit Sub
errH:
MsgBox ("Error number: " & Err.Number & ". Description: " & Err.Description)
Application.EnableEvents = True
End Sub

Resources