PDA

View Full Version : 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
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 ChangedThen
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