VBA ClearContents if true - excel

Trying to clear the contents if the cell equals 100 after the email is sent to prevent additional emails going out. I'm not wishing to clear all the range. Only if it = 100.
Private Sub Worksheet_Calculate()
If WorksheetFunction.CountIf(Range("I36:I44"), 100) Then
Call Mail_small_Text_Outlook
Range("I36:I44").ClearContents
End If
End Sub

You don't need a loop
Private Sub Worksheet_Calculate()
Dim pos As Variant
pos = Application.Match(100, Range("I36:I44"), 0)
If IsNumeric(pos) Then
Call Mail_small_Text_Outlook
Range("I36:I44").Cells(pos).Value = ""
End If
End Sub

Related

What to use instead of .EntireColumn

I'm trying to create a simple counting sheet which has 5 buttons to increment the count of each field, a 'New Round' Button to start a new round in a new column (R2 and so forth) and Clear button which clears all the counts and start over again from Round1
So far I've come up with this code:
Function rngLastRound() As Range
With Range("2:2").Cells(1, Columns.Count).End(xlToLeft)
Set rngLastRound = .EntireColumn
End With
End Function
Sub IncrementCurrentRoundOfRow(N As Long)
With rngLastRound
.Cells(N, 1).Value = Val(CStr(.Cells(N, 1).Value)) + 1
End With
End Sub
Sub IncrementCurrentRoundA()
Call IncrementCurrentRoundOfRow(3)
End Sub
Sub IncrementCurrentRoundB()
Call IncrementCurrentRoundOfRow(4)
End Sub
Sub IncrementCurrentRoundC()
Call IncrementCurrentRoundOfRow(5)
End Sub
Sub IncrementCurrentRoundD()
Call IncrementCurrentRoundOfRow(6)
End Sub
Sub IncrementCurrentRoundE()
Call IncrementCurrentRoundOfRow(7)
End Sub
Sub NewRound()
With rngLastRound.Offset(0, 1)
.Cells(2, 1).Value = "R" & (.Column - 1)
.Cells(3, 1).Resize(5, 1).Value = 0
End With
End Sub
Sub Clear()
Range("B2", rngLastRound).ClearContents
Call NewRound
End Sub
The code works fine, but it clears the entire columns so that means the totals and grand total also gets cleared. How do I prevent this from happening by not specifying .EntireColumn attribute and instead a specific range?
Thanks
A Game
Option Explicit
Function rngLastRound() As Range
With Range("2:2").Cells(Columns.Count).End(xlToLeft)
Set rngLastRound = .Resize(6)
End With
End Function
Sub IncrementCurrentRoundOfRow(N As Long)
With rngLastRound
.Cells(N).Value = Val(CStr(.Cells(N).Value)) + 1
End With
End Sub
Sub IncrementCurrentRoundA()
Call IncrementCurrentRoundOfRow(2)
End Sub
Sub IncrementCurrentRoundB()
Call IncrementCurrentRoundOfRow(3)
End Sub
Sub IncrementCurrentRoundC()
Call IncrementCurrentRoundOfRow(4)
End Sub
Sub IncrementCurrentRoundD()
Call IncrementCurrentRoundOfRow(5)
End Sub
Sub IncrementCurrentRoundE()
Call IncrementCurrentRoundOfRow(6)
End Sub
Sub NewRound()
With rngLastRound.Offset(, 1)
.Cells(1).Value = "R" & (.Column - 1)
.Cells(2).Resize(5).Value = 0
End With
End Sub
Sub Clear()
Range("B2", rngLastRound).ClearContents
Call NewRound
End Sub
Try changing the line Set rngLastRound = .EntireColumn in the rngLastRound () function to Set rngLastRound = Application.Intersect (.EntireColumn, Rows ("2: 7"))

Hide commandbutton based on cell value excel vba

I am trying to hide a commandbutton based on a specific cell value. I have looked up several codes and pasted them in excel (in the vba form when right clicking the sheet and selecting "view code").
What am I doing wrong?
Here's one of the codes I've tried:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1") = 0 Then ActiveSheet.CommandButton1.Visible = False
If Range("A1") = 1 Then ActiveSheet.CommandButton1.Visible = True
End Sub
Make sure you enable events before using your code. Also, you must place your code in Worksheet module, not in regular module. To enable events, use this simple sub.
Sub Enable_events()
Application.EnableEvents = True
End Sub
please run this first:
Sub enable_()
Application.EnableEvents = True
End Sub
and then your Code will run perfectly:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1") = 0 Then ActiveSheet.CommandButton1.Visible = False
If Range("A1") = 1 Then ActiveSheet.CommandButton1.Visible = True
End Sub
Your code is confusing, for a number of reasons.
Range, when it's not qualified with a Worksheet object, implicitly refers to the ActiveSheet, i.e. ActiveSheet.Range... but when it's in a worksheet's code-behind, it implicitly refers to that worksheet's Range property, i.e. Me.Range. Because the meaning of an unqualified Range call depends on context, it's best to always qualify it with an explicit Worksheet object.
So if you're in the code-behind module for Sheet1, then Range("A1") is equivalent to Sheet1.Range("A1"), or even better, Me.Range("A1").
The two conditions will be evaluated every time, but only one of them needs to be: it's inefficient.
Truth is, you don't need to assign a Boolean literal - a Boolean expression is much cleaner.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Me.CommandButton1.Visible = (Me.Range("A1") = 1)
End Sub
Now, assuming Application.EnableEvents returns True, that code will run every time the selection changes, which is rather overkill.
Handle the Worksheet.Change event instead, and only act when the modified cell is A1:
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Me.Range("A1")) Is Nothing And Target.Count <> 1 Then
' we don't care about that cell: bail out
Exit Sub
End If
Me.CommandButton1.Visible = (Me.Range("A1") = 1)
End Sub
Please try this code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
If Selection.Cells.Count = 1 Then
If Range("A1") = 0 Then ActiveSheet.CommandButton1.Visible = False
If Range("A1") = 1 Then ActiveSheet.CommandButton1.Visible = True
End If
End If
End Sub
Hope this help.

create a loop, that will fill 300 cells, from 300 checkboxes

I want to write a value (1) into a desired cell within Excel 2007, when I select a checkbox. The checkbox is in a Visual Basic userform, not on the active sheet itself.
The value (1) must revert back to zero when the checkbox is not selected.
I managed to get it working, however, I have more than 300 check-boxes, and want to know how to create one code that will do it in a loop?
{
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
ThisWorkbook.Sheets("sheet3").Range("b8").Value = 1
Else: ThisWorkbook.Sheets("sheet3").Range("b8").Value = 0
End If
End Sub
Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
ThisWorkbook.Sheets("sheet3").Range("b9").Value = 1
Else: ThisWorkbook.Sheets("sheet3").Range("b9").Value = 0
End If
End Sub
Private Sub CheckBox3_Click()
If CheckBox3.Value = True Then
ThisWorkbook.Sheets("sheet3").Range("b10").Value = 1
Else: ThisWorkbook.Sheets("sheet3").Range("b10").Value = 0
End If
End Sub
}
from checkbox 1 to checkbox 300, the cell range will be "B8" all the
way to "B308"
checkbox1 = cell range b8
checkbox2 = cell range b9
checkbox3 = cell range b10
checkbox4 = cell range b11
etc.......
Use IIf to set a value based on True or False.
Private Sub CheckBox1_Click()
ThisWorkbook.Sheets("sheet3").Range("B8").Value = IIf(CheckBox1.Value, 1, 0)
End Sub
Private Sub CheckBox2_Click()
ThisWorkbook.Sheets("sheet3").Range("B9").Value = IIf(CheckBox2.Value, 1, 0)
End Sub
Private Sub CheckBox3_Click()
ThisWorkbook.Sheets("sheet3").Range("B10").Value = IIf(CheckBox3.Value, 1, 0)
End Sub
I don't know how your workbook/userform looks in detail, but this should show pretty good how to do it:
First, we need the class which we will call Class1. In this class we put the code:
Option Explicit
Public WithEvents CBoxC As MSForms.CheckBox
Private Sub CBoxC_Change()
Dim i As Long
i = CLng(Replace(CBoxC.Name, "CheckBox", ""))
Sheet3.Cells(i + 7, 2).Value = 0 - CBoxC.Value
End Sub
Now we need a variable which "transfere" the events to our class. We jast add to any module:
Option Explicit
Public CBox() As New Class1
As the last step, we need to insert all the controls into our variable. So we add (or just include, if already there):
Option Explicit
Private Sub UserForm_Initialize()
Dim b As Variant
For Each b In Me.Controls
If TypeName(b) = "CheckBox" Then
If (0 / 1) + (Not Not CBox) = 0 Then ReDim CBox(0) Else ReDim Preserve CBox(UBound(CBox) + 1)
Set CBox(UBound(CBox)).CBoxC = b
End If
Next
End Sub
Instead of _Click we better use _Change. This way also keyboard-input will work...
As it is pretty much no code, it also should be self explaining. Just keep in mind, that such events will come last. (which should not matter in your case)
If you still have any questions, just ask ;)

"Ok" command box in userform

basically I have a userform which I would like to use to enter 2 data into another macro which I already have. The userform is as below:
Basically, I would like the OK button to be clicked and the data in the two boxes will be entered into another macro that I have. It would also be great if the OK button can help in a sense that it will prompt a warning if one of the boxes is not filled up.
So far, I do not have much of a code for this..
Private Sub UserForm_Click()
TextBox1.SetFocus
Sub Enterval()
End Sub
Private Sub TextBox1_Change()
Dim ID As String
ID = UserForm3.TextBox1.Value
End Sub
Private Sub TextBox2_Change()
Dim ID2 As String
ID2 = UserForm3.TextBox2.Value
End Sub
Private Sub OKay_Click()
Enterval
End Sub
Would appreciate any tips and help. Thanks!
My other macro
Private Sub CommandButton1_Click()
Dim Name As String
Dim Problem As Integer
Dim Source As Worksheet, Target As Worksheet
Dim ItsAMatch As Boolean
Dim i As Integer
Set Source = ThisWorkbook.Worksheets("Sheet1")
Set Target = ThisWorkbook.Worksheets("Sheet2")
Name = Source.Range("A3")
Problem = Source.Range("I13")
Do Until IsEmpty(Target.Cells(4 + i, 6)) ' This will loop down through non empty cells from row 5 of column 2
If Target.Cells(4 + i, 6) = Name Then
ItsAMatch = True
Target.Cells(4 + i, 7) = Problem ' This will overwrite your "Problem" value if the name was already in the column
Exit Do
End If
i = i + 1
Loop
' This will write new records if the name hasn't been already found
If ItsAMatch = False Then
Target.Cells(3, 6).End(xlDown).Offset(1, 0) = Name
Target.Cells(4, 6).End(xlDown).Offset(0, 1) = Problem
End If
Set Source = Nothing
Set Target = Nothing
End Sub
Thats the macro i have. As u said, i change the
othermacro
to CommandButton1_Click()
but it doesn't work
Quoting geoB except for one thing: when you .Show your UserForm from a main Sub, you can also .Hide it at the end and the macro that called it will continue its procedures.
Sub Okay_Click()
Dim sID1 As String, sID2 As String
' A little variation
If Me.TextBox1 = "" Or Me.TextBox2 = "" Then
MsgBox "Please fill all the input fields"
Exit Sub
End If
Me.Hide
End Sub
To address your TextBox, you can write in your main Sub UserForm3.TextBox1 for example
There is no need for an Enterval function. Instead, assume the user can read and follow instructions, then test whether that indeed is the case. Note that in your code ID and ID2 will never be used because they exist only within the scope of the subroutines in which they are declared and receive values.
To get started:
Sub Okay_Click()
Dim sID1 As String, sID2 As String
sID1 = UserForm3.TextBox1.Value
sID2 = UserForm3.TextBox2.Value
If Len(sID1 & vbNullString) = 0 Then
MsgBox "Box A is empty"
Exit Sub
End If
If Len(sID2 & vbNullString) = 0 Then
MsgBox "Box B is empty"
Exit Sub
End If
'Now do something with sID1, sID2
otherMacro(sID1, sID2)
End Sub
For your other macro, declare it like this:
Sub otherMacro(ID1, ID2)
...
End Sub
Also, the SetFocus method should occur in the form open event.

Excel VBA: Highlight textbox value after error occurs

I am trying to highlight entered value in TextBox. TextBox value is representing date value in date forma DD-MM-YYYY. I wrote some code to validate if inserted date is ok (in example 31 of April).
Hightlight itself is not a problem, however I want to do this right after an error occurs. So when I insert 31-04-2014, I should get the message "You have inserted wrong date" and the date value should hightlighted. For now it shows me message, highlights value and focus is set to another CommandButton
So far I made something like this:
Private Sub data_faktury_AfterUpdate()
Dim dzien As Byte, miesiac As Byte
Dim rok As Integer
On Error GoTo blad:
dzien = Mid(data_faktury.Value, 1, 2)
miesiac = Mid(data_faktury.Value, 4, 2)
rok = Right(data_faktury.Value, 4)
Call spr_date(dzien, miesiac, rok)
Exit Sub
blad:
If Err.Number = 13 Then
If data_faktury <> "" Then
If Len(data_faktury) < 10 Then: MsgBox ("Źle wpisana data faktury.")
End If
End If
End Sub
And code for 2nd procedure:
Sub zle()
MsgBox ("Wybrałeś zły dzień")
With Faktura.data_faktury
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
This is a bit long for a comment so here goes. The basic principle is to use the exit event and cancel when necessary. To prevent this being fired when you close the form, you need to use a flag variable - example userform code:
Private bSkipEvents As Boolean
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If bSkipEvents Then Exit Sub
With TextBox1
If Not IsValidDate(.Text) Then
Cancel = True
MsgBox "Invalid date"
.SelStart = 0
.SelLength = Len(.Text)
End If
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
bSkipEvents = True
End Sub

Resources