Macro flickering

Printable View

10-03-2016, 01:36 PM
Allkman

Macro flickering

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:

Code:

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.

Code:

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.
10-03-2016, 04:51 PM
SamT

Maybe something like

Code:

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
10-04-2016, 12:20 AM
Allkman

I tried to add this code above, to new Sub, and inside Worksheet_Calculate.

I get Compile error:
Next without For.

Any ideas?
10-04-2016, 05:51 AM
SamT

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.
10-04-2016, 06:54 AM
Allkman

Your code has For & Next,
But why Compile error: Says that "Next without For" ?

Code:

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
10-04-2016, 07:26 AM
Paul_Hossler

Code:

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
10-04-2016, 08:20 AM
Allkman

1 Attachment(s)

Attachment 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
10-04-2016, 12:20 PM
Allkman

This code runs on automatic cell change.

Code:

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
10-04-2016, 01:37 PM
SamT

Quote:

Your code has For & Next,
But why Compile error: Says that "Next without For" ?

The Bracket Sets are mixed up

Code:

For If Next End If

Edit to add: OK, you got that.
10-04-2016, 02:00 PM
Allkman

Everything is the same but with range it seem to not work..

Code:

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...

Code:

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
10-04-2016, 02:04 PM
SamT

Error: Object does not support. . .
Values is not a Range Property. Use the Property: Value.

Quote:

But now
LBound

Compile error:
Expected array

I wonder how you got pass the #438 Error

Quote:

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

Code:

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:
10-04-2016, 02:12 PM
SamT

BTW, that constant flickering is because Excel recalculates the sheet every time DDE changes any value on the sheet
10-05-2016, 01:29 PM
Allkman

1 Attachment(s)

I keep getting debug error:

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

Code:

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
10-05-2016, 01:45 PM
Paul_Hossler

This makes the variant NewValues =the range

Code:

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

I think you want something like

Code:

NewValues = ThisWorkbook.Worksheets("Quotes").Range("T4:U31").Value For i = LBound(NewValues,1 ) To UBound(NewValues, 1)
10-06-2016, 02:27 AM
Allkman

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
10-06-2016, 06:05 AM
SamT

Quote:

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:

Code:

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