Excel Macro VBA: Double click to tick issue - excel

how can I make the double click works ONLY when column 1,2,3 and 4 have values? I don't know where I should insert the code.. it's something like if column 1,2,3 and 4 have values then doubleclick.enable = TRUE else doubleclick.enable= FALSE..
Kindly need advice. My code is as follows:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Select Case Target.Column
Case 6, 13
If Not Intersect(Target, Range("F2:F13, M2:M13")) Is Nothing Then Cancel = True
Target.Font.Name = "Times New Roman"
If Target = "" Then
Target = ChrW(&H2713)
Else
MsgBox "You cannot modify the cell."
End If
End Select
End Sub

I am asking just to clarify the issue.
You only want to call doubleclick procedure if any cell in column 1 to 4 have value
Or you want to check if corresponding row has value?
for option 1, you may use
If Application.CountA(Range("A1:D" & Rows.Count)) > 0 Then
'Your Code
End If
for second option
If Application.CountA(Range("A" & target.Row & ":D" & target.Row)) > 0 Then
'Your Code
End If
I tested above codes but in case of any mistake, we can modify them

Related

Type Mismatch Error when selecting continuous cells to perform operations

I have a function ChangeTypeByDoubleClick assigned to the button Change Type in Bulk, this ChangeTypeByDoubleClick function throws a Type Mismatch Error.
Logic of my code & how it went wrong
To explain what is Change Type in Bulk:
Change Type in Bulk button calls the ChangeTypeByDoubleClick macro function.
ChangeTypeByDoubleClick function call the Worksheet_BeforeDoubleClick function, which performs double click on every cell selected.
Worksheet_BeforeDoubleClick function changes the cell values alternatively from "B&A" to "B" to "A" to "", whenever you perform double click on the cells.
The ChangeTypeByDoubleClick function throws a Type Mismatch Error, the error occurs in the Worksheet_BeforeDoubleClick function in the line
Elself target.Row > Range (Print_Something_Rg).Row And Len (Trim(target.Offset (, 1) .Value)) > 0 Then
whenever I select continuous cells, but there is no error when I select cells separately / only select 1 cell.
Variables in my code
Print_Something_Rg is a defined range, referring to the cell to the right of Type in the picture, you can consider Print_Something_Rg as the start of different product codes.
target is the cells we selected (if you refer to the picture you can see cells being selected)
Example of selecting cells separately:
Example of selecting continuous cells:
My code
Sub ChangeTypeByDoubleClick()
Call Sheet5. Worksheet_BeforeDoubleClick (Selection, False)
End Sub
Public Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
Dim rg_block As Range
If target.Column = Range(Print_Something_Rg).Offset(, -1).Column And Len(Trim (Range(Print_Something_Rg).Offset(1).Value)) > 0 Then
Cancel = TRUE
If target.Row = Range(Print_Something_Rg).Row Then
If Len (Trim(target.Offset(1, 1).Value)) > 0 Then
Set rg_block = Range (target.Offset (1, 1), target.Offset (1, 1) . End (xlDown)).Offset(, -1)
If target.Offset (1).Value = "" Then
rg_block.Value = "B & A"
Elself target.Offset (1).Value = "B & A" Then
rg_block.Value = "B"
Elself target.Offset(1).Value = "B" Then
rg_block.Value = "A"
Else
rg_block.Value = ""
End If
End If
Elself target.Row > Range (Print_Something_Rg).Row And Len (Trim(target.Offset (, 1) .Value)) > 0 Then
If target.Value = "" Then
target.Value =
"B & A"
Elself target.Value = "B & A" Then
target.Value = "B"
Elself target.Value = "B" Then
target.Value = "A"
Else
target.Value = ""
End If
End If
End If
End Sub
I am not exactly sure why would my code break when I select continuous cells, because the Selection should be a range already (so it shouldn't be wrong).
I have double checked the type of my code, and the type should be assigned properly. Considering it only breaks when I select continuous cells, my guess is that it has something to do with it - but I could not figure out why.
Any help would be greatly appreciated, thanks in advance.
When Target is a multi-cell range, its .Value is a 2D array, which you can't call Trim or Len on.
Normally this situation wouldn't even arise since you can only double-click a single cell, but obviously your case is different.
Add a loop to ChangeTypeByDoubleClick():
Sub ChangeTypeByDoubleClick()
If Not TypeOf Selection Is Range Then Exit Sub
Dim cell As Range
For Each cell in Selection
Sheet5.Worksheet_BeforeDoubleClick cell, False
Next
End Sub
As noted in the comments though, it would be much better to move the procedure into a standard module, and call that procedure within the Worksheet_BeforeDoubleClick handler.

use checkbox to hide/unhide rows based on cell value

Using VBA in excel, trying to understand how I can use a checkbox to hide/unhide any row that has a specific value in a specific column. My VBA skills are getting better more I practice but I am still not good with loops just yet. Appreciate any help you can provide. Here is what I have so far.
Private Sub CkBx_ShowAllRecords_Click()
If Me.CkBx_ShowAllRecords = True Then
For Each Row In Range("Table1").ListObject.ListColumns
If Row.Cells(1, "column5").Value = "Submission Complete" Then
Application.EntireRow.Visible=True
Next
End if
End Sub
Additionally when I uncheck the box I would want all rows where column 5 cell value equals "submission complete" would be hidden (just the opposite of what I put above when I check the box control).
Hope this may help you:
Private Sub CkBx_ShowAllRecords_Click()
Dim i As Long
If Me.CkBx_ShowAllRecords = True Then
For i = 1 To ActiveSheet.ListObjects("Table1").Range.Rows.Count
If ActiveSheet.ListObjects("Table1").DataBodyRange(i, 5).Value = "Submission Complete" Then
Rows((i + 1) & ":" & (i + 1)).Select
Selection.EntireRow.Hidden = True
End If
Next i
Else
ActiveSheet.Rows.EntireRow.Hidden = False
End If
Me.Hide
End Sub

Function that changes the cell color

I am creating a function where if a cell has Yellow color and if I enter 0 in that cell, then it pops up a message box Red then colors the cell Red. And then if I enter 1 it reverts the color to Yellow.
Here's my code:
Function ColorChange(range)
If range.Interior.ColorIndex = 6 And range.Value < 1 Then
MsgBox "Project Delay!", vbCritical, "Attention required!"
range.Interior.ColorIndex = 3
Else
If range.Interior.ColorIndex = 3 And range.Value > 0 Then
range.Interior.ColorIndex = 6
End If
End If
End Function
1) It is not necessary to use a function. In VBA you can program classically (and run the macro manually) or you can program event. It means that a macro will be running in case of a particular event (like a mouse-click or a modification in the sheet). That is why Siddarth Rout spoke about Worksheet_change, it is an event. In this case, define your Sub in this way and the following code will be executed in case of Worksheet modification.
2) You have to define a Private Sub for the specific worksheet. Private Sub Worksheet_change() and you put in argument ByVal Target As range. It means that you will receive information about the range that have been changed (Target).
3) After you will use Target.Address to define the range used by your code.
4) Your 2 intricate if statements are not necessary. It is better to use an if statement and an else if statement.
5) The following code is OK for me:
Private Sub Worksheet_change(ByVal Target As range)
If range(Target.Address).Interior.ColorIndex = 6 And range(Target.Address).Value < 1 Then
MsgBox "Project Delay!", vbCritical, "Attention required!"
range(Target.Address).Interior.ColorIndex = 3
ElseIf range(Target.Address).Interior.ColorIndex = 3 And range(Target.Address).Value > 0 Then
range(Target.Address).Interior.ColorIndex = 6
End If
End Sub

Listbox in Excel - How to determine no selection

I have an Excel spreadsheet with a listbox on sheet1 that populates from a named group on sheet2. There are 4 entries in this named group.
I want the user to make a selection from this listbox (1 column) before they do anything else. I'm trying to code to check for a valid selection from the listbox but, TopIndex = 0, and .Value, .Selection, .Selected either don't work or they return 0 but 0 is the index for the first entry in the listbox so it's like I always make a selection.
If I check for Listbox.value <> "" it returns null whether or not I make a selection.
I've searched the internet all night looking for a solution and keep coming up empty handed.
I'm stuck. Looking for suggestions.
You are possibly looking for this piece of code
If ListBox1.ListIndex = -1 Then
MsgBox "Nothing selected"
Else
MsgBox "Selected: " & ListBox1.ListIndex
End If
Listindex is equal -1 if nothing is selected in the listbox. Otherwise it is the index of the selected element starting with 0.
The above code works for a listbox where multiselect is false.
For a listbox with "multiselection" on this piece of code might probably help you
Dim i As Long
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
MsgBox "Selected: " & i
End If
Next i
Not sure why it didn't work for me but when I used
listbox1.listindex I kept getting 0
So, I changed how I populated my listbox by using
Private Sub Workbook_Open()
' Add site names to listbox
With Sheet1.ListBox1
.AddItem "Hayward"
.AddItem "Exeland"
.AddItem "StoneLake"
.AddItem "Winter"
End With
End Sub
Later on, when I coded to define the file I needed to open, I used
x = Sheet1.ListBox1.ListIndex
Select Case x
Case 0
sSite = "Hayward"
Case 1
sSite = "Exeland"
Case 2
sSite = "StoneLake"
Case 3
sSite = "Winter"
Case Else
MsgBox "You MUST select a Site Location", vbOKOnly
GetTargetFile = "NoSite"
Exit Function
End Select
GetTargetFile = sSite & sMonth & Yr & ".xlsx"
Now, Listbox1.ListIndex will return -1 if no selection made.
I think my original problem was in how I was trying to populate my listbox in that no matter what I did, both the FIRST and NO SELECTION returned 0.
Thanks for responding!
You need to count the selected items, then make the condition:
For a = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(a) = True Then
Numselections = Numselections + 1
End If
Next a
If Numselections < 1 Then
MsgBox ("Please select item!")
Exit Sub
End If

Alert when dynamic value is greater a number

I'm looking for a way for excel to alert me when a dynamic value (market feed data) is out of line by x%. The alert needs to appear in front of all my windows with a msg box "CHECK VALUES".
Is this possible to do and has anyone have an example of code for this?
More specifically
Minimum difference = 0.5
CELL A = 10
CELL B = 11
Difference = 1
ALERT user "Difference > 0.5"
Thank you in advance.
Thank you. This works perfect. Now I understand how it works, I'm hoping for another solution similar to the above. Both cells in A1 and B1 are constantly changing(variables). Cell C1 is the =ABS(B1-A1). What I need now is a code to alert me when Cell C1 is greater than 0.5.
You can use worksheet_change event. Try below code.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo err_rout
Application.EnableEvents = False
If Target.Address = "$A$1" And Target.CountLarge = 1 Then
If (Target.Value - Target.Offset(0, 1)) > 0.5 Then
MsgBox "CHECK VALUES"
End If
ElseIf Target.Address = "$B$1" And Target.CountLarge = 1 Then
If (Target.Value - Target.Offset(0, -1)) > 0.5 Then
MsgBox "CHECK VALUES"
End If
End If
err_rout:
Application.EnableEvents = True
End Sub

Resources