The reason your program stops is because you use "End", which terminates all
running VBA code. You should use "Exit sub" instead. I cleaned up the code
a little; take a look and let me know if you have any questions.


Public Sub TestViolet1()
Dim wkb As Workbook
Dim wks As Worksheet

For Each wks In wkb.Worksheets(Array("Korea", "China", "Malaysia",
"Brunei"))
Call changes(wks)
Next wks
End Sub



Public Sub Reset(wks As Worksheet)

End Sub



Public Sub changes(wks As Worksheet)
Dim topCel As Range
Dim bottomCel As Range
Dim sourceRange As Range
Dim compareRange As Range
Dim x As Integer
Dim i As Integer
Dim numofRows As Integer
Dim lngRetVal As Long

Call Reset(wks)

'finding last column
If (wks.Cells(1, 24) < 0) Then ' Dec
If (Changes_Sub(wks, topCel, bottomCel, sourceRange, compareRange,
"X2", "X65536", "W2") = -9) Then Exit Sub
ElseIf wks.Cells(1, 23) < 0 Then ' Nov
If (Changes_Sub(wks, topCel, bottomCel, sourceRange, compareRange,
"W2", "W65536", "V2") = -9) Then Exit Sub
ElseIf wks.Cells(1, 22) < 0 Then ' Oct
If (Changes_Sub(wks, topCel, bottomCel, sourceRange, compareRange,
"V2", "V65536", "U2") = -9) Then Exit Sub
ElseIf wks.Cells(1, 21) < 0 Then ' Sep
If (Changes_Sub(wks, topCel, bottomCel, sourceRange, compareRange,
"U2", "U65536", "T2") = -9) Then Exit Sub
ElseIf wks.Cells(1, 20) < 0 Then ' Aug
If (Changes_Sub(wks, topCel, bottomCel, sourceRange, compareRange,
"T2", "T65536", "S2") = -9) Then Exit Sub
ElseIf wks.Cells(1, 19) < 0 Then ' Jul
If (Changes_Sub(wks, topCel, bottomCel, sourceRange, compareRange,
"S2", "S65536", "R2") = -9) Then Exit Sub
ElseIf wks.Cells(1, 18) < 0 Then ' Jul
If (Changes_Sub(wks, topCel, bottomCel, sourceRange, compareRange,
"R2", "R65536", "Q2") = -9) Then Exit Sub
ElseIf wks.Cells(1, 17) < 0 Then ' May
If (Changes_Sub(wks, topCel, bottomCel, sourceRange, compareRange,
"Q2", "Q65536", "P2") = -9) Then Exit Sub
ElseIf wks.Cells(1, 16) < 0 Then ' Apr
If (Changes_Sub(wks, topCel, bottomCel, sourceRange, compareRange,
"P2", "P65536", "O2") = -9) Then Exit Sub
ElseIf wks.Cells(1, 15) < 0 Then ' Mar
If (Changes_Sub(wks, topCel, bottomCel, sourceRange, compareRange,
"O2", "O65536", "N2") = -9) Then Exit Sub
ElseIf wks.Cells(1, 14) < 0 Then ' Feb
If (Changes_Sub(wks, topCel, bottomCel, sourceRange, compareRange,
"n2", "n65536", "m2") = -9) Then Exit Sub
Else
Exit Sub
End If

numofRows = sourceRange.Rows.Count

'compare the difference and format the row
numofRows = sourceRange.Rows.Count
For i = 1 To numofRows
If ((sourceRange(i) < compareRange(i)) And (sourceRange(i) <
compareRange(i))) Then
wks.Rows(i + 1).Interior.ColorIndex = 4
Else
If ((sourceRange(i) < compareRange(i)) And (sourceRange(i)
compareRange(i))) Then
wks.Rows(i + 1).Interior.ColorIndex = 6
End If
End If
Next
End Sub




Public Function Changes_Sub(wks As Worksheet, topCel As Range, bottomCel As
Range, sourceRange As Range, compareRange As Range, strTopCel As String,
strBottomCel As String, strCompareRange As String) As Long

Changes_Sub = -1

Set topCel = wks.Range(strTopCel)
Set bottomCel = wks.Range(strBottomCel).End(xlUp)
If (topCel.Row bottomCel.Row) Then
Changes_Sub = -9
Exit Function
End If
Set sourceRange = wks.Range(topCel, bottomCel)
Set compareRange = wks.Range(strCompareRange)

Changes_Sub = 0
End Function





"violet" wrote:

hi, here the code:

Sub changes(wks As Worksheet)
Call reset(wks)
Dim topCel As Range, bottomCel As Range, _
sourceRange As Range, compareRange As Range
Dim x As Integer, i As Integer, numofRows As Integer

'finding last column
If wks.Cells(1, 24) < 0 Then
Set topCel = wks.Range("X2")
Set bottomCel = wks.Range("X65536").End(xlUp)
If topCel.Row bottomCel.Row Then End ' test if source range is empty
Set sourceRange = wks.Range(topCel, bottomCel)
Set compareRange = wks.Range("W2")
ElseIf wks.Cells(1, 23) < 0 Then
Set topCel = wks.Range("W2") ' For Nov
Set bottomCel = wks.Range("W65536").End(xlUp)
If topCel.Row bottomCel.Row Then End ' test if source range is empty
Set sourceRange = wks.Range(topCel, bottomCel)
Set compareRange = wks.Range("V2")
ElseIf wks.Cells(1, 22) < 0 Then
Set topCel = Range("V2") 'For Oct
Set bottomCel = wks.Range("V65536").End(xlUp)
If topCel.Row bottomCel.Row Then End ' test if source range is empty
Set sourceRange = wks.Range(topCel, bottomCel)
Set compareRange = wks.Range("U2")
ElseIf wks.Cells(1, 21) < 0 Then
Set topCel = wks.Range("U2") 'For Sept
Set bottomCel = wks.Range("U65536").End(xlUp)
If topCel.Row bottomCel.Row Then End ' test if source range is empty
Set sourceRange = wks.Range(topCel, bottomCel)
Set compareRange = wks.Range("T2")
ElseIf wks.Cells(1, 20) < 0 Then
Set topCel = wks.Range("T2") 'For Aug
Set bottomCel = wks.Range("t65536").End(xlUp)
If topCel.Row bottomCel.Row Then End ' test if source range is empty
Set sourceRange = wks.Range(topCel, bottomCel)
Set compareRange = wks.Range("S2")
ElseIf wks.Cells(1, 19) < 0 Then
Set topCel = wks.Range("S2") 'For July
Set bottomCel = wks.Range("S65536").End(xlUp)
If topCel.Row bottomCel.Row Then End ' test if source range is empty
Set sourceRange = wks.Range(topCel, bottomCel)
Set compareRange = wks.Range("R2")
ElseIf wks.Cells(1, 18) < 0 Then
Set topCel = wks.Range("R2") 'For June
Set bottomCel = wks.Range("R65536").End(xlUp)
If topCel.Row bottomCel.Row Then End ' test if source range is empty
Set sourceRange = wks.Range(topCel, bottomCel)
Set compareRange = wks.Range("Q2")
ElseIf wks.Cells(1, 17) < 0 Then
Set topCel = wks.Range("Q2") 'For May
Set bottomCel = wks.Range("Q65536").End(xlUp)
If topCel.Row bottomCel.Row Then End ' test if source range is empty
Set sourceRange = wks.Range(topCel, bottomCel)
Set compareRange = wks.Range("P2")
ElseIf wks.Cells(1, 16) < 0 Then
Set topCel = wks.Range("P2") 'For April
Set bottomCel = wks.Range("P65536").End(xlUp)
If topCel.Row bottomCel.Row Then End ' test if source range is empty
Set sourceRange = wks.Range(topCel, bottomCel)
Set compareRange = wks.Range("O2")
ElseIf Cells(1, 15) < 0 Then
Set topCel = wks.Range("O2") 'For March
Set bottomCel = wks.Range("O65536").End(xlUp)
If topCel.Row bottomCel.Row Then End ' test if source range is empty
Set sourceRange = wks.Range(topCel, bottomCel)
Set compareRange = wks.Range("N2")
ElseIf wks.Cells(1, 14) < 0 Then
Set topCel = wks.Range("N2") 'For Feb
Set bottomCel = Range("N65536").End(xlUp)
If topCel.Row bottomCel.Row Then End ' test if source range is empty
Set sourceRange = wks.Range(topCel, bottomCel)
Set compareRange = wks.Range("M2")
Else
End
End If
numofRows = sourceRange.Rows.Count

'compare the difference and format the row
numofRows = sourceRange.Rows.Count
For i = 1 To numofRows
If sourceRange(i) < compareRange(i) And sourceRange(i) <
compareRange(i) Then
wks.Rows(i + 1).Interior.ColorIndex = 4
Else
If sourceRange(i) < compareRange(i) And sourceRange(i)
compareRange(i) Then
wks.Rows(i + 1).Interior.ColorIndex = 6
End If
End If
Next
End Sub


"Bob Phillips" wrote:

Can you show us the changes macro please Violet?

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"violet" wrote in message
...
got another problem now...you c my code is for highlighting changes..now
prob
is that when one of the sheet that i declare in the array is empty..the
array
of worksheet seem like will not load as any sheet that is declare after
the
blank sheet, the macro "changes" will not work on those sheets.

eg.

For Each wks In wkb.Worksheets(Array("Korea", "China", "Malaysia",
"Brunei"))
call changes
next wks

if korea sheet has no data, "china" sheet and the rest will not execute
changes

"violet" wrote:

i have written a sub test_values in modules named Identifychages. I know
that
by runing the module it will perform the sub on the excel worksheet that
i am
opening. however, i wish to run this sub on mulitiple worksheets on the
same
workbook.how can i do it?anyone can give me advice? i still very new to
vba
coding in excel.