I am running a small VBA to loop through a range of rows (27 - 52) to return a simple multiplication of column D X column E to column F.
My code below crashes Excel. Can anyone point out the obvious as to where i am going wrong. I am clearly no expert!
Private Sub Worksheet_Change(ByVal Target As Range)
For i = 27 To 52
Cells(i, 6) = Cells(i, 4) * Cells(i, 5)
Next i
End Sub
Thanks
Excel will crash as your code is creating an infinite loop, due to Change Event that you are using. Every time your code multiplies two given cells it is being identified as a change event, so your code will be triggered again, and again...
You can either use the adjusted code that Michal has posted, or you can adjust your original code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
For i = 27 To 52
Cells(i, 6) = Cells(i, 4) * Cells(i, 5)
Next i
Application.EnableEvents = True
End Sub
Hope it helps!
I don't see how it would "crash" Excel, abyway you don't need Change(ByVal Target As Range)so it's simply:
Private Sub foo()
For i = 27 To 52
Cells(i, 6).Value = Cells(i, 4).Value * Cells(i, 5).Value
Next i
End Sub
Related
I've put together a macro that is meant to increase dates by one in an array of 7 cells ("B2:H2"), (reflecting 7d in a week) once B2 value is changed.
I am sure there is a better way of writing this:
Sub Date_Increment
' increases consecutive days by 1
Range("c2").Value = Range("b2").Value + 1
Range("d2").Value = Range("c2").Value + 1
Range("e2").Value = Range("d2").Value + 1
Range("f2").Value = Range("e2").Value + 1
Range("g2").Value = Range("f2").Value + 1
Range("h2").Value = Range("g2").Value + 1
End Sub
This feels a bit too Neanderthal.
Much appreciate any help.
Use loop. Try-
Sub Date_Increment()
Dim i As Integer
For i = 1 To 7
Cells(2, 2 + i) = Cells(2, 2).Value + i
Next i
End Sub
You can try this:
Sub Date_Increment
' increases consecutive days by 1
Dim i as Long
For i=1 to 6
Range("c2").Cells(i,1).Value = Range("b2").Cells(i,1).Value + 1
Next i
End Sub
Note: Range("c2") implies ActiveSheet.Range("c2") so unless this is code under a specific worksheet you need to be aware that it will only work if the sheet holding the dates is the active sheet.
See if below code is useful for you.
Sub Date_Increment2()
With Range("C2:H2")
.Formula = "=B2+1"
.Value = .Value
End With
End Sub
Personally, I'd leave cell C2 onwards as formula cells as then any change in B2 would get reflected immediately.
I am trying to insert a value into my excel sheet and it keeps changing the string into a date. For example, I am trying to past 2-4 (One of the names for one Unit we use) and instead, I get February 4, 2020. Is there a way to prevent it from being changed?
x = 5
For i = 1 To TheEnd - 1
If IsEmpty(LANL(i, 1)) Then
If Percent(i, 1) = 1 Then
Cells(x, 1) = SU(i, 1)
x = x + 1
End If
End If
Next i
If we do something like:
Sub qwerty()
With ActiveCell
.Clear
.NumberFormat = "#"
.Value = "2-4"
.ClearFormats
End With
End Sub
Our result would be:
I have trouble doing a simple code. I want to add If Then statement, if the condition is met (a cell value is not 1 or 7), then do a block of codes, otherwise end the sub. The block of codes include login to a website and 2 For Next loops. Basically the macro is to run during weekdays and not run if it's Saturday or Sunday. Appreciate your help.
Here's a test code:
Sub test()
Dim i As Integer
'If cell E1 has a value of neither 1 or 7, Do stuff, otherwise End the Sub
If Cells(5, 1) <> 1 Or Cells(5, 1) <> 7 Then
'Do stuff includes login and perform 2 For Next loops in my real code
For i = 1 To 3
Cells(i, 1).Value = Cells(i, 1).Value * 2
Next
End If
End Sub
Try
Sub test()
Dim i As Integer
'If cell E1 has a value of neither 1 or 7, Do stuff, otherwise End the Sub
If Cells(5, 1) = 1 Or Cells(5, 1) = 7 Then
Else
'Do stuff includes login and perform 2 For Next loops in my real code
For i = 1 To 3
Cells(i, 1).Value = Cells(i, 1).Value * 2
Next
End If
End Sub
I finally able to do achieve what I want. I created a new sub that check the day of the week and if it's Saturday or Sunday Then Exit Sub, Else call the original sub that I have and it works great. However as Comintern suggested, I will look into the VBA function of checking date instead of using the spreadsheet. Thanks to all.
Skip my rambling narrative by scrolling down to tldr and Question.
I have several rows and columns with values; e.g. A10:G15. In each row, the value of the cell immediately to the right of any cell is dependent on that cell up to the extents of the columns involved. In this manner, the value of a cell immediately to the right of any cell is always numerically larger than the cell or blank if the original cell is blank.
To maintain this dependency, I want to clear any values to the right if I clear the value from a cell within A:F or progressively add a random number to the remaining cells to the right if I input a new value into any cell within A:F.
Sample data. The 7 in the top-left is A10.
A B C D E F G
7 12 15 19 23 27 28
4 6 10 14 17 18 22
8 10 14 18 23 26 31
8 13 15 18 22 25 30
8 13 16 18 19 21 24
0 3 4 9 10 12 16
'similar data in A19:G22 and A26:G30
tldr
▪ If I clear D12, E12:G12 should also be cleared.
▪ If I type a new value into C14 then D14:G14 should each receive a new value which is random but larger than the previous value.
▪ I might want to clear or paste in several values in a column and would expect the routine to deal with each in turn.
▪ I have several of these non-contiguous regions (see Union'ed range in code sample below) and would prefer a DRY coding style.
Code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'Debug.Print Target.Address(0, 0)
If Not Intersect(Target, Range("A10:F15, A19:F22, A26:F30")) Is Nothing Then
Dim t As Range
For Each t In Intersect(Target, Range("A10:F15, A19:F22, A26:F30"))
If IsEmpty(t) Then
t.Offset(0, 1).ClearContents
ElseIf Not IsNumeric(t) Then
t.ClearContents
Else
If t.Column > 1 Then
If t <= t.Offset(0, -1) Or IsEmpty(t.Offset(0, -1)) Then
t.ClearContents
Else
t.Offset(0, 1) = t + Application.RandBetween(1, 5)
End If
Else
t.Offset(0, 1) = t + Application.RandBetween(1, 5)
End If
End If
Next t
End If
End Sub
Code explanation
This event driven Worksheet_Change deals with each cell that has changed but only modifies the cell directly to the right, not the remaining cells in that row. The job of maintaining the remaining cells is achieved by leaving event triggers active so that when that single cell to the right is modified, the Worksheet_Change triggers an event that calls itself with a new Target.
Question
The above routine seems to run fine and I have yet to destabilize my project environment despite my best/worst efforts. So what's wrong with intentionally running a Worksheet_Change on top of itself if the reiteration cycles can be controlled to a finite result?
I would argue that what is wrong with recursively triggering the change event is that this way Excel can only sustain a pretty tiny call stack. At 80 calls it killed my Excel instance. When I outsourced the recursion I at least got to a little over 1200 calls, of course adding redundancy to some extent:
Option Explicit
Const RANGE_STR As String = "A10:F15, A19:F22, A26:F30"
Private Sub Worksheet_Change(ByVal target As Range)
Application.EnableEvents = False
Dim t As Range
If Not Intersect(target, Range(RANGE_STR)) Is Nothing Then
For Each t In Intersect(target, Range(RANGE_STR))
makeChange t
Next t
End If
Application.EnableEvents = True
End Sub
Sub makeChange(ByVal t As Range)
If Not Intersect(t, Range(RANGE_STR)) Is Nothing Then
If IsEmpty(t) Then
t.Offset(0, 1).ClearContents
makeChange t.Offset(0, 1)
ElseIf Not IsNumeric(t) Then
t.ClearContents
makeChange t
Else
If t.Column > 1 Then
If t <= t.Offset(0, -1) Or IsEmpty(t.Offset(0, -1)) Then
t.ClearContents
makeChange t
Else
t.Offset(0, 1) = t + Application.RandBetween(1, 5)
makeChange t.Offset(0, 1)
End If
Else
t.Offset(0, 1) = t + Application.RandBetween(1, 5)
makeChange t.Offset(0, 1)
End If
End If
End If
End Sub
I don't think you need recursive calls, read by area, by row, into array, change array and write back to sheet:
Const RANGE_STR As String = "A10:F15, A19:F22, A26:F30"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyArr As Variant, TargetR As Long, TargetC As Long, i As Long, ar As Range, myRow As Range
Dim minC As Long, maxC As Long
If Not Intersect(Target, Range(RANGE_STR)) Is Nothing Then
minC = Range(RANGE_STR).Column 'taken form first area
maxC = 1 + Range(RANGE_STR).Columns.Count 'taken form first area
For Each ar In Target.Areas
TargetC = ar.Column
For Each myRow In ar.Rows
TargetR = myRow.Row
MyArr = Range(Cells(TargetR, minC), Cells(TargetR, maxC))
If IsEmpty(MyArr(1, TargetC)) Or Not IsNumeric(MyArr(1, TargetC)) Then
For i = TargetC To UBound(MyArr, 2)
MyArr(1, i) = Empty
Next i
Else
For i = TargetC + 1 To UBound(MyArr, 2)
MyArr(1, i) = MyArr(1, i - 1) + Application.RandBetween(1, 5)
Next i
End If
If Not Intersect(Range(Cells(TargetR, minC), Cells(TargetR, maxC)), Range(RANGE_STR)) Is Nothing Then
Application.EnableEvents = False
Range(Cells(TargetR, minC), Cells(TargetR, maxC)) = MyArr
Application.EnableEvents = True
End If
Next myRow
Next ar
End If
End Sub
I wrote a macro to check the value being entered in some cells.
If the input is higher than 8 the excess is written to another cell and the input is changed to 8. If the input is lower than 8 the missing amount is written to a third cell.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
TA = Target.Address: R = Target.Row: C = Target.Column
If C = 2 Or C = 7 Then
If (R < 19 And R > 11) Or (R < 33 And R > 25) Then
Hours = Cells(R, C).Value
If Hours <> 0 Then
If Hours > 8 Then
Cells(R, C) = 8
Cells(R, C + 1) = Hours - 8
End If
If Hours < 8 Then
Cells(R, C + 2) = 8 - Hours
End If
End If
End If
End If
End Sub
The problem is the macro is not executed when I enter the input, only when I select the cell again.
First change your trigger event from Worksheet_SelectionChange to Worksheet_Change.
Second, you can optimize your code, since you can read the Column and Row property of Target, you can save a few rows in your code.
Third, I modified your test condition for checking the row, by switching to Select Case you can now add more rows to this condition easily.
Use Target.offset to insert the result in the neighbour cells.
I added Exit Sub so it won't run an extra time after you change the values here.
If you want, you can also remove the Hours as it is not needed (unless you have a global variable that somehow reads this value).
You can just use If Target.Value <> 0 Then etc.)
Private Sub Worksheet_Change(ByVal Target As Range)
' check if target is in Column B or Column G
If Target.Column = 2 Or Target.Column = 7 Then
Select Case Target.Row
Case 12 To 18, 26 To 32 ' check if target row is 12 to 18 (including) ir between 26 to 32 (including)
Hours = Target.Value
If Hours <> 0 Then
If Hours > 8 Then
Target.Value = 8
Target.Offset(0, 1).Value = Hours - 8
Exit Sub
Else
If Hours < 8 Then
Target.Offset(0, 2).Value = 8 - Hours
End If
Exit Sub
End If
End If
End Select
End If
End Sub
Your function Worksheet_SelectionChange only fires when the selected cell is changed. You should use Worksheet_Change instead. You can see this automatically execute an Excel macro on a cell change for more details.