PDA

View Full Version : [SLEEPER:] Macro flickering



Allkman
10-03-2016, 01:36 PM
Hello,

My worksheet is getting live data from DDE to excel.
I need macro to run only when the value in T and U columns are = 1
I have a piece of code witch is working.
Problem is that it is flickering constantly.

What i have tried:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

It only works when i insert value anywhere on the sheet..

I need it to run automatically, when the value in T changes to = 1, from False..

Looking for solution to this, thank you.



Option Explicit

Sub Worksheet_Calculate()
Dim FormulaRange As Range
Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String
Dim SentMsg2 As String
Dim MyLimit As Double
NotSentMsg = ""
SentMsg = "Alert"
SentMsg2 = "e-Mail sent"
' Above the MyLimit value it will run the macro
MyLimit = 0
' Set the range with the Formula that i want to check
Set FormulaRange = Me.Range("T4:T31")
'MsgBox "Cell " & .Address & " has changed."
' On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
With FormulaCell
If .Offset(0, 4).Value <> SentMsg2 Then
If IsNumeric(.Value) = False Then
MyMsg = ""
Else
If .Value > MyLimit Then
MyMsg = SentMsg
'MsgBox "11111"
If .Offset(0, 2).Value = NotSentMsg Then
Call Mail_with_outlook_BuyMsg
End If
Else
MyMsg = NotSentMsg
End If
End If
Application.EnableEvents = False
.Offset(0, 2).Value = MyMsg 'inserted "Alert" message
' MsgBox "01 BUY nothing"
Application.EnableEvents = True
If .Offset(0, 2).Value = SentMsg Then
.Offset(0, 4).Value = SentMsg2 'inserted "e-Mail sent" message
End If
End If
End With
Next FormulaCell
' ExitMacro:
Call Worksheet_Calculate2
' EndMacro:
' Application.EnableEvents = True
' MsgBox "Some Error occurred."
' & vbLf & Err.Number & vbLf & Err.Description
' Application.ScreenUpdating = True
End Sub


Macro for U Column is the same as for T.

SamT
10-03-2016, 04:51 PM
Maybe something like

Static OldValues as Variant
Dim NewValues as Variant
Dim Changed As Boolean
Dim i As Integer
NewValues = Me.Range("T4:T31").Values
If Not IsArray(OldValues) Then ' Only true on first run after opening Workbook
OldValues = NewValues
Else
For i = LBound(NewValues) to UBound(NewValues)
If NewValues(i) <> OldValues(i) Then
Changed = True
OldValues = NewValues
Exit For
End IF
Next
End If
If Not Changed then Exit Sub

Allkman
10-04-2016, 12:20 AM
I tried to add this code above, to new Sub, and inside Worksheet_Calculate.

I get Compile error:
Next without For.

Any ideas?

SamT
10-04-2016, 05:51 AM
You will get the same message when any Bracket Set is mismatched.

Bracket Sets are If-End, With-End, Do-Loop, and this one, For-Next. Read the code upwards to see what the previous Bracket Starter was.

Allkman
10-04-2016, 06:54 AM
Your code has For & Next,
But why Compile error: Says that "Next without For" ?


Static OldValues As Variant
Dim NewValues As Variant
Dim Changed As Boolean
Dim i As Integer
NewValues = Me.Range("T4:T31").Values
If Not IsArray(OldValues) Then ' Only true on first run after opening Workbook
OldValues = NewValues
Else
For i = LBound(NewValues) To UBound(NewValues)
If NewValues(i) <> OldValues(i) Then
Changed = True
OldValues = NewValues
Exit For
Next
End If
If Not Changed Then
Exit Sub

Paul_Hossler
10-04-2016, 07:26 AM
Static OldValues As Variant
Dim NewValues As Variant
Dim Changed As Boolean
Dim i As Integer
NewValues = Me.Range("T4:T31").Values
If Not IsArray(OldValues) Then 'Only true on first run after opening Workbook
OldValues = NewValues
Else
For i = LBound(NewValues) To UBound(NewValues)
If NewValues(i) <> OldValues(i) Then
Changed = True
OldValues = NewValues
Exit For
' Next ' reversed
' End If ' reversed
End If
' NewValues(i) <> OldValues(i) Then
Next I
End If ' might just not be copy/pasted

Allkman
10-04-2016, 08:20 AM
17258
NewValues = Me.Range("T4:T31") is incorrect

I changed to: Dim NewValues As Range (it was set as Variant)

Worked.


But now
LBound

Compile error:
Expected array

Allkman
10-04-2016, 12:20 PM
This code runs on automatic cell change.

Private Sub Worksheet_Calculate()Static oldValue
If Range("T4").Value <> oldValue Then
oldValue = Range("T4").Value
MsgBox "There has been a change"
End If
End Sub

But what if i need it to check multiple cells i mean columns.
Range("T4:T31").Value ends up in error (type missmatch)
in my case range is T4:U31 (or T4:T31 U4:U31)

How to tell it to check range, not single cell

SamT
10-04-2016, 01:37 PM
Your code has For & Next,
But why Compile error: Says that "Next without For" ?

The Bracket Sets are mixed up

For
If
Next
End If
Edit to add: OK, you got that.

Allkman
10-04-2016, 02:00 PM
Everything is the same but with range it seem to not work..






Private Sub Worksheet_Calculate()
Static oldVal
Dim newVal As Range
Set newVal = ThisWorkbook.Worksheets("Quotes").Range("T4:U9")
If Range("T4:U9").Value <> oldVal Then
oldVal = Range("T4:U9").Value
MsgBox "Works"
' rest of code here
End If
End Sub


even when i Set newVal
and place it after If, result:
Type missmatch...


Private Sub Worksheet_Calculate()
Static oldVal
Dim newVal As Range
Set newVal = ThisWorkbook.Worksheets("Quotes").Range("T4:U9")
If newVal.Value <> oldVal Then
oldVal = newVal.Value
MsgBox "Works"
' rest of code here
End If
End Sub

SamT
10-04-2016, 02:04 PM
Error: Object does not support. . .
Values is not a Range Property. Use the Property: Value.


But now
LBound

Compile error:
Expected array
I wonder how you got pass the #438 Error




range is T4:U31
Setting a Variant to the Value of a two column Range creates a 2D array. You need to check both columns in the Array


NewValues = Range("T4:U31").Value
For i = LBound(NewValues) To UBound(NewValues)
If NewValues(i, 1) <> OldValues(i, 1) Or NewValues(i, 2) <> OldValues(i, 2)Then
Changed = True
OldValues = NewValues
Exit For 'Found a Change, no need to look further.
End If
Next i
If Changed Then MsgBox "At Least one Cell in T4:U31 Has Changed"
If Not Changed Then Exit Sub


There are no deliberate mistakes in this code :devil2:

SamT
10-04-2016, 02:12 PM
BTW, that constant flickering is because Excel recalculates the sheet every time DDE changes any value on the sheet

Allkman
10-05-2016, 01:29 PM
I keep getting debug error:

For i = LBound(NewValues) To UBound(NewValues)



Private Sub Worksheet_Calculate()
Static OldValues As Variant
Dim NewValues As Variant
Dim Changed As Boolean
Dim i As Integer
Set NewValues = ThisWorkbook.Worksheets("Quotes").Range("T4:U31")
' in this range T4:U31 i need macro to test if cell changed from false ""(nothing)to true "1"
For i = LBound(NewValues) To UBound(NewValues)
If NewValues(i, 1) <> OldValues(i, 1) Or NewValues(i, 2) <> OldValues(i, 2) Then
Changed = True
OldValues = NewValues
Exit For 'Found a Change, no need to look further.
End If
Next i
If Changed Then MsgBox "At Least one Cell in T4:U31 Has Changed" 'if changed then i Call function
If Not Changed Then Exit Sub
End Sub


I attached screenshot

Paul_Hossler
10-05-2016, 01:45 PM
This makes the variant NewValues =the range




Set NewValues = ThisWorkbook.Worksheets("Quotes").Range("T4:U31")



I think you want something like




NewValues = ThisWorkbook.Worksheets("Quotes").Range("T4:U31").Value

For i = LBound(NewValues,1 ) To UBound(NewValues, 1)

Allkman
10-06-2016, 02:27 AM
I appreciate your help but i am stuck with Lower Bound and Upper Bound, and i cant figure out the work around(no matter what it always end up on error "Type missmatch")..

Worksheet_Change stops macro, and it only runs when i manually work with sheet.
Not when a change occure from live data calculation (automatically).
I tried to look into stackoverflow, but no answer witch would work for me..

Change Event? can it be on Automatic Change?

I hope i am explaining myself clear, so that you can understand my issue.
Maybe vba is build so it recalculate whenever there is a change in worksheet, in my case change happens every second.. macro is heavy on sheet, it makes excel run very slow

SamT
10-06-2016, 06:05 AM
I appreciate your help but i am stuck with Lower Bound and Upper Bound, and i cant figure out the work around(no matter what it always end up on error "Type missmatch")..

Did you do this
CODE:

Set NewValues = ThisWorkbook.Worksheets("Quotes").Range("T4:U31").Value