Help with VBA

S

sonicscooter

Hi, this works for one cell, but how do i use this for several hundred cells
independently of each other, ie monitor cells, it compares A to B, if A is
higher than B, it beeps, G1 flashes slowly, and copies A to B, input to A is
from a DDE link from another program, so if A then changes again, higher than
its previous value, the sequence starts again, so you end up with B being the
maximum value of the time period that i monitored the event or if a certain
value is reached i can have a message appear in B1 to alert me to do
somthing, but although it works for one cell, i wish to compare,

A1 > B1
A2 > B2
A3 > B3 and so on, do i have to change it from, Private Sub
Worksheet_Calculate() to something else to asighn it to each set of cells ?
or copy this dozens of times but change the Private Sub
Worksheet_Calculate(). im completely lost as to how to do it.

Thanks for any help.

Private Sub Worksheet_Calculate()
If Range("A1") > Range("B1") Then
Beep
Range("A1").Copy
If Range("A1") > Range("B1") Then Range("B1").PasteSpecial
Paste:=xlPasteValues
Dim newColor As Integer
Dim myCell As Range
Dim x As Integer
Dim fSpeed
Set myCell = Range("G1")
newColor = 42
fSpeed = 0.4
Do Until x = 10
DoEvents
Start = Timer
Delay = Start + fSpeed
Do Until Timer > Delay
DoEvents
myCell.Interior.ColorIndex = newColor
Loop
Start = Timer
Delay = Start + fSpeed
Do Until Timer > Delay
DoEvents
myCell.Interior.ColorIndex = xlNone
Loop
x = x + 1
Loop
End If
End Sub
 
J

joel

Private Sub Worksheet_Calculate()

Dim newColor As Integer
Dim myCell As Range
Dim x As Integer
Dim fSpeed

LastRow = Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow

If Range("A" & RowCount) > Range("B" & RowCount) Then
Beep
Range("A" & RowCount).Copy
Range("B" & RowCount).PasteSpecial _
Paste:=xlPasteValues

Set myCell = Range("G" & RowCount)
newColor = 42
fSpeed = 0.4
Do Until x = 10
DoEvents
Start = Timer
Delay = Start + fSpeed

Do Until Timer > Delay
DoEvents
myCell.Interior.ColorIndex = newColor
Loop

Start = Timer
Delay = Start + fSpeed

Do Until Timer > Delay
DoEvents
myCell.Interior.ColorIndex = xlNone
Loop
x = x + 1
Loop
End If
Next RowCount
End Sub
 
S

sonicscooter

Joel, thankyou for the very fast responce, i was thinking i would have to
make my version about half a mile long with all the cells i needed to
monitor, and then end up with "procedure too long" etc i've never used
RowCount as yet, so i will try your version and mess with it, so far i works
really well.

Thankyou again....Cheers.
 
S

sonicscooter

Hi Joel, i've adjusted it to my own needs and it works spot on, thankyou again.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top