Excel VBA multiple change events causing insufficient stacking space - excel

I'm making a form to calculate the price rooms we rent out. Among others this cost is based on the arrival and departure date. You can see a screenshot of the form below;
- "Aankomst" (the first date) means "Arrival"
- "Vertrek" (the second date) means "Departure"
As you can see, I added buttons to respectively decrease or increase the dates. I also made sure that impossible values would be rectified. The departure date can never be equal or lower than the arrival date. When trying to decrease the departure date, or increase the arrival date, this is triggered when wrong.
When inputting values manually, this check does not occur. A bit of searching learned me I could do this with a change event macro.
I wrote this bit of code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$B$5" And Range("$b$5").Value + 1 >= Range("$b$6").Value Then
Range("$b$6").Value = Range("$b$5").Value + 1
End If
If Target.Address = "$B$6" And Range("$b$6").Value - 1 <= Range("$b$5").Value Then
Range("$b$5").Value = Range("$b$6").Value - 1
End If
Application.ScreenUpdating = True
End Sub
B5 is the cell containing the arrival date, b6 is the cell containing the departure date. When triggered, this macro should check both which cell was changed (b5 or b6) and if the arr. date is equal to or higher than the dep. date. And if so, automatically change the other cell (the one that was not manually changed).
Now when I omit the second if-statement, it works just fine. If I omit the second if-statement, it works fine as well. When both statements are active, it bugs everytime. I get a prompt saying 'insufficient stacking space' (translated from dutch).
I've tried this code as well, using case:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Range("b6").Value - 1 <= Range("b5").Value Then
Select Case Target.Address(0, 0)
Case "b5": Range("vertrek").Value = Range("aankomst").Value + 1
Case "b6": Range("aankomst").Value = Range("vertrek").Value - 1
End Select
End If
Application.ScreenUpdating = True
End Sub
...but also without success, same error. When I debug, I can see that the date was indeed changed if necessary, so I presume I somehow create an infinite loop or smth and that causes Excel to bug.
Does anyone know where my error lies or anyone aware of another method to achieve my goal?

Protect against re-raising the same event over and over:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Address = "$B$5" And Range("$b$5").Value + 1 >= Range("$b$6").Value Then
Range("$b$6").Value = Range("$b$5").Value + 1
End If
If Target.Address = "$B$6" And Range("$b$6").Value - 1 <= Range("$b$5").Value Then
Range("$b$5").Value = Range("$b$6").Value - 1
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Related

Excel 365 VBA for hours and minutes format

I'm working on a simple Excel file with some worksheets where in every one I've report hours and minutes of work. I want to show it like 313:32 that is 313 hours and 32 minutes, to do that I'm using a custom format [h]:mm
To facilitate the workers that use Excel very little, I have thought to create some vba code, so that they could insert also not only the minutes, besides the classical format [h]:mm, so they can also insert value in hours and minutes.
I report some example data that I want to have.
What I insert -> what I want that are printed inside the cell
1 -> 0:01
2 -> 0:02
3 -> 0:03
65 -> 1:05
23:33 -> 23:33
24:00 -> 24:00
24:01 -> 24:01
Then I formatted every cell that can contain a time value in [h]:mm and I wrote this code
Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo bm_Safe_Exit
With Sh
If IsNumeric(Target) = True And Target.NumberFormat = "[h]:mm" Then
If Int(Target.Value) / Target.Value = 1 Then
Debug.Print "Integer -> " & Target.Value
Application.EnableEvents = False
Target.Value = Target.Value / 1440
Application.EnableEvents = True
Exit Sub
End If
Debug.Print "Other value -> " & Target.Value
End If
End With
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
The code works well enough, but it errs when I enter 24:00 and its multiples, 48:00, 72:00 ...
This because the cell are formatted [h]:mm so 24:00 became 1 before the vba code execution!
I tried to correct the code, and the funny fact is that when I correct the 24:00, so 24:00 remain 24:00 and not 00:24, the problem switch to 1 that became 24:00 instead 00:01
My first idea was to "force" the vba code execution before the cell format, but I don't know if it is possible.
I know that seems a stupid question, but I really don't know if it is possible and how to fix it.
Any idea will be much appreciated
Requirements: Time is to be reported in Hours and Minutes, minutes is the lowest measure ( i.e.: whatever the amount of time is to be reported in hours and the partial hours in minutes, i.e. 13 days, 1 hour and 32 minutes or 13.0638888888888889 shall be shown as 313:32 )
Users should be allowed to enter time in two different manners:
To enter only minutes: The value entered shall be a whole number (no decimals).
To enter hours and minutes: The value entered shall be composed by two whole numbers representing the hours and the minutes separated a colon :.
Excel Processing Values Entered:
Excel intuitively process the Data type and Number.Format of the values entered in cells.
When the Cell NumberFormat is General, Excel converts the values entered to the data type in relation with the data entered (String, Double, Currency, Date, etc. ), it also changes the NumberFormat as per the “format” entered with the value (see table below).
When the Cell NumberFormat is other than General, Excel converts the values entered to the data type corresponding to the format of the cell, with no changes to the NumberFormat (see table below).
Therefore, it's not possible to know the format of the values as entered by the user, unless the values entered can be can intercepted before Excel applies its processing methods.
Although the values entered cannot be intercepted before Excel process them, we can set a validation criteria for the values entered by the users using the Range.Validation property.
Solution: This proposed solution uses:
Workbook.Styles property (Excel): To identify and format the Input cells.
Range.Validation property (Excel): To communicate the users the format required for the values entered, enforcing them to enter the data as text.
Workbook_SheetChange workbook event: To validate and process the values entered.
It's suggested to use a customized style to identify and format the input cells, actually OP is using the NumberFormat to identify the input cells, however it seems that there could also be cells with formulas, or objects (i.e. Summary Tables, PivotTables, etc.) that require the same NumberFormat. By using the customized style only for the input cells, the non-input cells can be easily excluded from the process.
The Style object (Excel) allows to set the NumberFormat, Font, Alignment, Borders, Interior and Protection at once for a single or multiple cells. The procedure below adds a customized Style named TimeInput. The name of the Style is defined as a public constant because it will be used across the workbook.
Add this into an standard module
Public Const pk_StyTmInp As String = "TimeInput"
Private Sub Wbk_Styles_Add_TimeInput()
With ActiveWorkbook.Styles.Add(pk_StyTmInp)
.IncludeNumber = True
.IncludeFont = True
.IncludeAlignment = True
.IncludeBorder = True
.IncludePatterns = True
.IncludeProtection = True
.NumberFormat = "[h]:mm"
.Font.Color = XlRgbColor.rgbBlue
.HorizontalAlignment = xlGeneral
.Borders.LineStyle = xlNone
.Interior.Color = XlRgbColor.rgbPowderBlue
.Locked = False
.FormulaHidden = False
End With
End Sub
The new Style will show in the Home tab, just select the input range and apply the Style.
We’ll use the Validation object (Excel) to tell users the criteria for the time values and to force them to enter the values as Text.
The following procedure sets the style of the Input range and adds a validation to each cell:
Private Sub InputRange_Set_Properties(Rng As Range)
Const kFml As String = "=ISTEXT(#CLL)"
Const kTtl As String = "Time as ['M] or ['H:M]"
Const kMsg As String = "Enter time preceded by a apostrophe [']" & vbLf & _
"enter M minutes as 'M" & vbLf & _
"or H hours and M minutes as 'H:M" 'Change as required
Dim sFml As String
Application.EnableEvents = False
With Rng
.Style = pk_StyTmInp
sFml = Replace(kFml, "#CLL", .Cells(1).Address(0, 0))
With .Validation
.Delete
.Add Type:=xlValidateCustom, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=sFml
.IgnoreBlank = True
.InCellDropdown = False
.InputTitle = kTtl
.InputMessage = kMsg
.ShowInput = True
.ErrorTitle = kTtl
.ErrorMessage = kMsg
.ShowError = True
End With: End With
Application.EnableEvents = True
End Sub
The procedure can be called like this
Private Sub InputRange_Set_Properties_TEST()
Dim Rng As Range
Set Rng = ThisWorkbook.Sheets("TEST").Range("D3:D31")
Call InputRange_Set_Properties(Rng)
End Sub
Now that we have set the input range with the appropriated style and validation, let’s write the Workbook Event that will process the Time inputs:
Copy these procedures in ThisWorkbook module:
Workbook_SheetChange - Workbook event
InputTime_ƒAsDate - Support function
InputTime_ƒAsMinutes - Support function
…
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const kMsg As String = "[ #INP ] is not a valid entry."
Dim blValid As Boolean
Dim vInput As Variant, dOutput As Date
Dim iTime As Integer
Application.EnableEvents = False
With Target
Rem Validate Input Cell
If .Cells.Count > 1 Then GoTo EXIT_Pcdr 'Target has multiple cells
If .Style <> pk_StyTmInp Then GoTo EXIT_Pcdr 'Target Style is not TimeInput
If .Value = vbNullString Then GoTo EXIT_Pcdr 'Target is empty
Rem Validate & Process Input Value
vInput = .Value 'Set Input Value
Select Case True
Case Application.IsNumber(vInput): GoTo EXIT_Pcdr 'NO ACTION NEEDED - Cell value is not a text thus is not an user input
Case InStr(vInput, ":") > 0: blValid = InputTime_ƒAsDate(dOutput, vInput) 'Validate & Format as Date
Case Else: blValid = InputTime_ƒAsMinutes(dOutput, vInput) 'Validate & Format as Minutes
End Select
Rem Enter Output
If blValid Then
Rem Validation was OK
.Value = dOutput
Else
Rem Validation failed
MsgBox Replace(kMsg, "#INP", vInput), vbInformation, "Input Time"
.Value = vbNullString
GoTo EXIT_Pcdr
End If
End With
EXIT_Pcdr:
Application.EnableEvents = True
End Sub
…
Private Function InputTime_ƒAsDate(dOutput As Date, vInput As Variant) As Boolean
Dim vTime As Variant, dTime As Date
Rem Output Initialize
dOutput = 0
Rem Validate & Process Input Value as Date
vTime = Split(vInput, ":")
Select Case UBound(vTime)
Case 1
On Error Resume Next
dTime = TimeSerial(CInt(vTime(0)), CInt(vTime(1)), 0) 'Convert Input to Date
On Error GoTo 0
If dTime = 0 Then Exit Function 'Input is Invalid
dOutput = dTime 'Input is Ok
Case Else: Exit Function 'Input is Invalid
End Select
InputTime_ƒAsDate = True
End Function
…
Private Function InputTime_ƒAsMinutes(dOutput As Date, vInput As Variant) As Boolean
Dim iTime As Integer, dTime As Date
Rem Output Initialize
dOutput = 0
Rem Validate & Process Input Value as Integer
On Error Resume Next
iTime = vInput
On Error GoTo 0
Select Case iTime = vInput
Case True
On Error Resume Next
dTime = TimeSerial(0, vInput, 0) 'Convert Input to Date
On Error GoTo 0
If dTime = 0 Then Exit Function 'Input is Invalid
dOutput = dTime 'Input is Ok
Case Else: Exit Function 'Input is Invalid
End Select
InputTime_ƒAsMinutes = True
End Function
The table below shows the output for various types of values entered.
The simplest way appears to be to use the cell text (i.e. how the cell is displayed) in preference to the actual cell value. If it looks like a time (e.g. "[h]:mm", "hh:mm", "hh:mm:ss") then use that to add the value of each time part accordingly (to avoid the 24:00 issue). Otherwise, if it's a number, assume that to be minutes.
The below method also works for formats like General, Text and Time (unless the time begins with a days part, but it could be further developed to deal with that too where necessary).
Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo bm_Safe_Exit
Dim part As String, parts() As String, total As Single
Application.EnableEvents = False
If Not IsEmpty(Target) And Target.NumberFormat = "[h]:mm" Then
'prefer how the Target looks over its underlying value
If InStr(Target.Text, ":") Then
'split by ":" then add the parts to give the decimal value
parts = Split(Target.Text, ":")
total = 0
'hours
If IsNumeric(parts(0)) Then
total = CInt(parts(0)) / 24
End If
'minutes
If 0 < UBound(parts) Then
If IsNumeric(parts(1)) Then
total = total + CInt(parts(1)) / 1440
End If
End If
ElseIf IsNumeric(Target.Value) Then
'if it doesn't look like a time format but is numeric, count as minutes
total = Target.Value / 1440
End If
Target.Value = total
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub

How to Hide and Unhine rows using dollar figures using VBA

My apologies if my question is too basic. I am trying to achieve the following results
If Cell E11 value is less than 25,000, then hide Rows 14 & 15.
If Cell E11 value is between 25k-50k, then hide only row 15 only.
If Cell E11 value is between 50k-75k, then unhide both rows.
And it is possible to make the calculation automated?
So far I found the following code, which of course isn't helping with my situation.
Sub PG1()
If Range("E11").Value = "Pass" Then
Rows("14:14").EntireRow.Hidden = True
ElseIf Range("E11").Value = "Fail" Then
Rows("14:14").EntireRow.Hidden = False
End If
End Sub
A minor amount of trial and error based on nothing else but the code you posted gave me this code, which should get you started. It completes two of the three requirements (using different cells and rows), but it works. If it's still not something you can use to complete your task, you should probably hire someone to do this for you.
Sub ShowOrHide()
If ActiveSheet.Range("A1").Value < 25000 Then
ActiveSheet.Rows("2:3").EntireRow.Hidden = True
ElseIf ActiveSheet.Range("A1").Value >= 50000 Then
ActiveSheet.Rows("2:3").EntireRow.Hidden = False
End If
End Sub
Here you go.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$11" Then
If Target.Value < 25000 Then Rows("13:15").EntireRow.Hidden = True
If Target.Value > 25000 Then Rows("13:14").EntireRow.Hidden = False
If Target.Value > 50000 Then Rows("13:15").EntireRow.Hidden = False
If Target.Value > 75000 Then Rows("13:15").EntireRow.Hidden = True
End If
End Sub

Worksheet.Change Event in Excel in real time

Take as example the following code which should state whether the content of Cell A3 is greater or smaller than 0.25, where in Cell A3 we have a formula like RAND() whoch generates random numbers between 0 and 1.
Private Sub Worksheet_Change(ByVal Target As Range)
Calculate
If Range("A3") > 0.25 Then
Range("B3") = "greater than 0.25"
Else: Range("B3") = "smaller than 0.25"
End If
End Sub
How to make this Event conditions to be verified in continuous time?
What about using timer? this function calls each 1 second
Sub Test()
Calculate
If Range("A3") > 0.25 Then
Range("B3") = "greater than 0.25"
Else
Range("B3") = "smaller than 0.25"
End If
Application.OnTime Now + TimeSerial(0, 0, 1), "Test"
End Sub
I think there is no option for that. Have been looking for it myself. There is no change event for calculated cells. The only option is to check dependencies of a calculated field but in this case there are none.

Create a macro that is executed when a cel value chages (not by the user)

Ok I have a worksheet "Goal 0" that with some ranges, make some calculations like...
(in A1)
=SUM(G2:G68)*I17
Then if I add/modify any of the values in 62-G68, the cell is auto calculated (numbers that are mainly negative and some possitive).
The objetive is: According to the sum of the range, find the value of I17 where the result of A1 is equal or more than 0. (Starting from 0, incrementing it 1 by 1, decimals not needed)
Manually I can add change i17 untill it reaches the goal. How ever I want to make it automatically, so if a value in the range of G2 to G68 changes it recalculate the value of I17, untill (A1 calculation gets value equal or higher than 0) but if already is higger or equal than 0 then do nothing.
Hope I explain it well
EDIT: Now I created this code ...
Function IncreaseTheValue()
If Range("A1") < 0 Then
Range("I17").Value = 0
Do While Range("A1").Value < 0
Range("I17").Value = Range("I17").Value + 1
Loop
End If
End Function
And works perfect, how ever it does not fires when I make a chage. How do I do that...
I try adding this in A2 cell but did not worked ...
=IF(A1 < 0, IncreaseTheValue(), "")
Regards
You shouldn't really be doing this as a Function; it is inadequate as you notice, but also not appropriate use of a Function where a Sub or event handler is more appropriate.
Based on your requirements, put the code in the Worksheet_Change event handler. You will need to fine-tune it so that it only fires when a change is made in the range G2:G68.
Try this (untested):
Private Sub Worksheet_Change(ByVal Target as Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("G2:G68")) Is Nothing Then
If Range("A1") < 0 Then
Range("I17").Value = 0
Do While Range("A1").Value < 0
Range("I17").Value = Range("I17").Value + 1
Loop
End If
End If
Application.EnableEvents = True
End Sub
Updated per pnuts comments. This method below will trigger the macro any time any cell changes -- this might be overkill, or it might be necessary if G2:G68 is formulas which change based on changes to other cells. Either method can be fine-tuned to better suit your exact needs.
Private Sub Worksheet_Change(ByVal Target as Range)
Application.EnableEvents = False
If Range("A1") < 0 Then
Range("I17").Value = 0
Do While Range("A1").Value < 0
Range("I17").Value = Range("I17").Value + 1
Loop
End If
Application.EnableEvents = True
End Sub

Excel Programming for auto-complete of partial input (numbers)

We manage our inventories in Excel. I know its little old fashioned but we are developing business firm, and we have all our money blocked in business and no money to invest in IT.
So I wanted to know can I program in a way that excel automatically completes the product numbers?
This is example of one product category
All our design codes are of 6 digits, What I really want is that when only partial number is added and hit enter it automatically completes the remaining digits by taking the above numbers.
So for example in this case what I am expecting is, if I type 5 hit enter it automatically makes it 790705 based on above number.
Add the following VBA code to the code section of your worksheet:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oldText As String, aboveText As String, newText As String
If Target.Column = 2 And Target.Row >= 3 And Target.Text <> "" Then
oldText = Target.Text
aboveText = Target.Cells(0, 1).Text
If Len(aboveText) = 6 And Len(oldText) < 6 Then
newText = Left(aboveText, 6 - Len(oldText)) & oldText
Application.EnableEvents = False
Target.Value = newText
Application.EnableEvents = True
End If
End If
End Sub
(change the column number and minimum row number above according to the actual column/row numbers in your worksheet).
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If (Target.Column = 2 And Target.Row > 2 And Target.Value < 10) Then
Target = Target.Offset(rowOffset:=-1) + 1
End If
End Sub
As far as you enter a single digit in the new row, it transforms to the previous row + 1.

Resources