VBA 2 IF conditions applied for column - vba

this is my first post, please be patient if I'm doing/asking something wrong.
My issue is:
I got 2 columns, A is number of children, B is name of those children.
Those values are manually entered, I simply would like to have B mandatory if A is filled.
Here is what I thought:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not IsEmpty(Sheet1.Range("A1")) Then
If IsEmpty(Sheet1.Range("B1")) Then
MsgBox "Please fill in cell B1 before closing."
Cancel = True
Else '
End If
End If
End Sub
This is actually working perfectly, unfortunately I can't manage to extend it for whole columns, when replacing A1 with A1:A1000 and B1 with B1:B1000 for instance,it doesn't work.
How can I validate this for both entire column A and B?
thanks in advance!

Try this
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cancel = Evaluate("SUMPRODUCT(--(ISBLANK(Sheet1!B:B) <> ISBLANK(Sheet1!A:A)))")
If Cancel Then MsgBox "Please fill in column B before closing."
End Sub
EDIT
In order to take the user to the place where data is missing, and taking into account the additional information you provided about your data, try this:
'Private Sub Workbook_BeforeClose(Cancel As Boolean)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim r: r = Evaluate( _
"MATCH(FALSE, ISBLANK('ELENCO AGGIORNATO'!V:V) = ISBLANK('ELENCO AGGIORNATO'!W:W), 0)")
If IsError(r) Then Exit Sub ' All is fine
Cancel = True
Application.Goto Sheets("ELENCO AGGIORNATO").Cells(r, "V").Resize(, 2)
msgBox "Please fill missing data before saving."
End Sub
Also note that I recommend Workbook_BeforeSave instead of Workbook_BeforeClose, because there's no harm if the user decides to drop his (incomplete) work and close the workbook without saving.

You may try something like this...
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim str As String
Dim Rng As Range, Cell As Range
Dim FoundBlank As Boolean
Set Rng = Sheet1.Range("A1:A1000")
str = "Please fill the cells listed below before colsing..." & vbNewLine & vbNewLine
For Each Cell In Rng
If Cell <> "" And Cell.Offset(0, 1) = "" Then
FoundBlank = True
str = str & Cell.Address(0, 1) & vbNewLine
End If
Next Cell
If FoundBlank Then
Cancel = True
MsgBox str, vbExclamation, "List of Blank Cells Found!"
End If
End Sub

Related

VBA Macro triggering too often

My worksheet is set up with data validation dropdowns and I am wanting a macro to ONLY trigger when the value of the cell is changed from another value in the dropdown, not from the default "empty" value.
Here is what I am trying to use:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then
If IsEmpty(Target.Value) = True Then
MsgBox "Test1"
Else
MsgBox "Test2"
End If
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
End Sub
My problem is that this "IsEmpty" command is reading the cell AFTER the selection not before. I want it to read what the cells value was BEFORE the selection not after.
How can I do this?
Example approach:
Const COL_CHECK As Long = 5
Private oldVal
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Set c = Target.Cells(1) '<< in case multiple cells are changed...
If c.Column = COL_CHECK Then
If oldVal <> "" Then
Debug.Print "changed from non-blank"
Else
Debug.Print "changed from blank"
End If
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range
Set c = Target.Cells(1)
oldVal = IIf(c.Column = COL_CHECK, c.Value, "")
Debug.Print "oldVal=" & oldVal
End Sub
Another approach:
This will need one cell per validation-dropdown:
Function ValChange(Cell2Follow As Range) As String
ValChange = ""
If Len(Application.Caller.Text) = 0 Then Exit Function
If Application.Caller.Text = Cell2Follow.Text Then Exit Function
MsgBox "value of the cell is changed from another value in the dropdown" & vbLf & "not from the default 'empty' value"
End Function
in a different cell, assumed the dropdown is in E6:
=E6&ValChange(E6)
application.caller.text will be the old value
(calculation must be automatic)

Warning message in Excel macro if combobox null

I create combo box selection using userform in Excel macro.
What I want to do is, to prevent the user to click OK without selecting a value.
Here is my code, I don't know what is wrong, the message box doesn't show.
Private Sub UserForm_Initialize()
ComboBox1.RowSource = "Sheet1!G1:G" & Range("G" & Rows.Count).End(xlUp).Row
ComboBox2.RowSource = "Sheet1!G1:G" & Range("G" & Rows.Count).End(xlUp).Row
End Sub
Private Sub CommandButton1_Click()
If IsNull(ComboBox1) Then
MsgBox ("ComboBox Has Data")
End If
Workbooks("Select Project.xlsm").Sheets("Sheet1").Range("B2").Value = ComboBox1.Value
Workbooks("Select Project.xlsm").Sheets("Sheet1").Range("C2").Value = ComboBox2.Value
End Sub
Can anybody help what is wrong with my code? Sorry, I'm new to VBA.
You're not checking the Text property of your ComboBox. You should process like this.
Private Sub CommandButton1_Click()
If (ComboBox1.Text = "") Then
MsgBox "ComboBox Has No Data"
Exit Sub
End If
Workbooks("Select Project.xlsm").Sheets("Sheet1").Range("B2").Value = ComboBox1.Value
Workbooks("Select Project.xlsm").Sheets("Sheet1").Range("C2").Value = ComboBox2.Value
End Sub
What changed ?
I changed If IsNull(ComboBox1) Then with If (ComboBox1.Text = "") Then so this will check the Text property in your ComboBox.
I also added Exit Sub to leave the function if the ComboBox is empty so it doesn't commit the operation after.
IsNull(ComboBox1) and IsNull(ComboBox1).Value will both never be true. Null is a value returned from a database if a field contains no value. You have to check if the value of the ComboBox is empty. An empty string in VBA is a string with the length 0, so you have to use on of those:
If Me.ComboBox1 = "" then ...
If Me.ComboBox1.Value = "" then ...
If Me.ComboBox1.Text = "" then ...
(For the difference between value and text-property see Distinction between using .text and .value in VBA Access)
Anyhow, I would go for the solution to enable/disable the button (as Rosetta suggested). Put a event-routine to the Combobox:
Private Sub ComboBox1_Change()
Me.CommandButton1.Enabled = Me.ComboBox1.Value <> ""
End Sub

How can i call a Sub using hyperlinks

I am newbie to VBA; I have a question:
How can I call sub to delete a cell in a sheet by using a Hyperlinks from another sheet.
A structure of the code is greatly appreciated.
Event handler in worksheet which contains the hyperlink:
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
If Target.TextToDisplay = "Clear Cell" Then
ClearThatCell
End If
End Sub
Note there's also a Workbook-level event: use that if you'd like to be able to trap any hyperlink click in the workbook.
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, _
ByVal Target As Hyperlink)
End Sub
Called code:
Sub ClearThatCell()
ThisWorkbook.Sheets("Sheet2").Range("A1").ClearContents
End Sub
' Public m_data_wks As Worksheet
Sub init_links
Dim v_r As Range, n_rows as Integer
Set v_r = m_data_wks.Cells(1, 1)
n_rows = 3 'is an example of filling up cells with hyperlinks
For I = 1 To n_rows
v_r.Value = I
'The key: adding hyperlink to the v_r cell with a special subaddress for alternative usage.
'The hyperlink looks like the ordinary but points to itself.
m_data_wks.Hyperlinks.Add Anchor:=v_r, Address:="", SubAddress:=v_r.Address(External:=False, RowAbsolute:=False, columnAbsolute:=False)
Set v_r = v_r.Offset(1)
Next I
end sub
'Private WithEvents App As Application
Private Sub App_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
Dim v_dst As Worksheet, v_index_s As String, v_index_i As Integer
'get_context sets v_dst the proper worksheet
'get_context Sh.Parent, v_dst
If v_dst Is Nothing Then Exit Sub
On Error GoTo Ext
'Using the value of the cell for choosing which to delete
v_index_s = CStr(Sh.Range(Target.SubAddress).Value)
If v_index_s = "#" Then
v_index_i = 0
Else
v_index_i = CLng(v_index_s)
End If
'Here the v_index_i points to the row instead of a cell for deleting
v_dst.Rows(v_index_i).Delete
Exit Sub
Ext:
If Err.Number <> 0 Then
MsgBox "Error occured while deleting by hyperlink: " & Err.Number & ", " & Err.Description, vbExclamation, "Non critical error"
Err.Clear
End If
End Sub

Runtime Error 1004 while trying to add a range to a script in VBA

The script below works fine for a single cell, but when I am trying to add the Range Q3:Q200, it throws the Runtime Error 1004.
VBA script:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As _
Boolean, Cancel As Boolean)
With Sheets(" Sheet3 ").Range(" Q3 ")
If .Value = " Shirts " Then
If Range(" R3 ") = "" Then
MsgBox " Save has been cancelled. You must fill Type of Shirts "
Cancel = True
End If
End If
End With
End Sub
You need to iterate through the range to find values of "Shirts". Try this:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim c As Range
For Each c In Range("Sheet3!Q3:Q200")
Debug.Print c.Address & " " & c.Value
If c.Value = "Shirts" Then
If c.Offset(0, 1).Value = "" Then
MsgBox "Save has been cancelled. You must fill Type of Shirts"
Cancel = True
Exit Sub
End If
End If
Next
End Sub
Alternatively, you could use Range("Sheets3!Q3:Q200").Find("Shirts") but I think that will actually require more code.

VBA BeforeSave check for Missing Data

I'm struggling with some VBA code and the BeforeSave methodology.
I've been all over the forums but can't locate the answer I need, so would love some help please.
My question! On saving I need the code to look at Column H (named Claim USD) of a 'Table' (named Claims) for a number value and then if any of the cells has a value to then look at Column I (named Claim Date) and make sure there is a date in there. I have already data validated column I to only accept date entries.
I have found the code below, and tested it for what it does and it works. I'm just not sure how to incorporate my element. Can anyone offer me some help?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim rsave As Range
Dim cell As Range
Set rsave = Sheet2.Range("I8,I500")
For Each cell In rsave
If cell = "" Then
Dim missdata
missdata = MsgBox("missing data", vbOKOnly, "Missing Data")
Cancel = True
cell.Select
Exit For
End If
Next cell
End Sub
I have created a custom Class for validation see here. It is very overkill for what you are trying to do but what it will allow you to do is capture all of the cells with errors and do what you'd like with them. You can download and import the 2 class modules Validator.cls and ValidatorErrors.cls And then use the following
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Unflag
Dim rsave As Range
Dim rcell As Range
Dim v AS New Validator
Set rsave = Sheet2.Range("Table1[Estimate Date]")
with v
For Each rcell In rsave
.validates rcell,rcell.address
.presence
Next rcell
End With
If not(v.is_valid) Then
FlagCollection v.errors
MsgBox("Missing data in " & v.unique_keys.Count & " Cell(s).", vbOKOnly, "Missing Data")
Cancel = True
End IF
Set v = Nothing
End Sub
Public Sub flag(flag As String, comment As String)
Dim comments As String
If has_comments(flag) Then
comments = Sheet2.Range(flag).comment.Text & vbNewLine & comment
Else
comments = comment
End If
Sheet2.Range(flag).Interior.Color = RGB(255, 255, 102)
Sheet2.Range(flag).ClearComments
Sheet2.Range(flag).AddComment comments
End Sub
Public Sub FlagCollection(all_cells As Collection)
Dim flag_cell As ValidatorError
For Each flag_cell In all_cells
flag flag_cell.field, flag_cell.error_message
Next flag_cell
End Sub
Public Sub Unflag()
Cells.Select
Selection.Interior.ColorIndex = xlNone
Selection.ClearComments
End Sub
Public Function has_comments(c_cell As String) As Boolean
On Error Resume Next
Sheet1.Range(c_cell).comment.Text
has_comments = Not (CLng(Err.Number) = 91)
End Function
This will flag every field that has an error in yellow and add a comment as to what the issue is you could also determine a way to tell the user exactly where the errors are using v.uniq_keys which returns a collection of cell address' that fail validation of presence.
I'm pretty sure I cracked it, well it works anyway. Code below (for those who are interested anyway!!)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim rsave As Range
Dim cell As Range
Set rsave = Sheet2.Range("Table1[Estimated Claim (USD)]")
For Each cell In rsave
If cell.Value <> "" And cell.Offset(0, 1).Value = "" Then
Dim missdata
missdata = MsgBox("Missing Data - Enter the Date for WorkBook to Save", vbOKOnly, "Missing Data")
Cancel = True
cell.Offset(0, 1).Select
Exit For
End If
Next cell
End Sub
I've now got to loop this through three other column headers checking for same criteria. If anyone knows a quicker code method. Would appreciate the help!