applying modules to mulitple worksheet

V

violet

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

Bill Pfister

Violet, you want to pass the worksheet(s) as a parameter into your sub.
Then you can call the sub from another routine and pass in the worksheets.
Here's an example:


public sub test_values_Master( )
dim wkb as workbook
dim wks as worksheet

set wkb = activeworkbook ' or set wkb equal to any workbook you want

for each wks in wkb.worksheets
call test_values( wks )
next wks
end sub


public sub test_values( wks as worksheet )
' perform operations on wks
end sub

Hope this helps - let me know if it wasn't what you were looking for.

Regards,
Bill
 
V

violet

Bill,

The code you have for me is for all the worksheets in the workbook?what if i
wan only selected few?
 
B

Bob Phillips

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

Set wkb = ActiveWorkbook ' or set wkb equal to any workbook you want

For Each wks In wkb.Worksheets(Array("Sheet2", "Sheet3"))
Call test_values(wks)
Next wks
End Sub

--
HTH

Bob Phillips

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

violet

strange..it doesn't work...

Bob Phillips said:
Public Sub test_values_Master()
Dim wkb As Workbook
Dim wks As Worksheet

Set wkb = ActiveWorkbook ' or set wkb equal to any workbook you want

For Each wks In wkb.Worksheets(Array("Sheet2", "Sheet3"))
Call test_values(wks)
Next wks
End Sub

--
HTH

Bob Phillips

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

Bob Phillips

You have to change the values in the array to your sheet names

--
HTH

Bob Phillips

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

Bill Pfister

Violet, to carry Bob's example further, I've included examples where you can
either explicitly state which sheets to include (sub
PrintSelectSheets_FixedSet) or you can use selective criteria to determine
which sheets to select (sub PrintSelectSheets_Variable looks to see if the
value in cell "A1" of each sheet is true).



Public Sub PrintSelectSheets_FixedSet()
Dim wkb As Workbook
Dim strSheets() As String

Set wkb = ThisWorkbook

' Put all the sheets to print into the strSheets array
ReDim strSheets(0 To 1) As String

strSheets(0) = "a a"
strSheets(1) = "c c"

wkb.Sheets(strSheets).Select
End Sub



Public Sub PrintSelectSheets_Variable()
Dim wkb As Workbook
Dim strSheets() As String
Dim lngFound As Long
Dim i As Long

Set wkb = ThisWorkbook
lngFound = -1

' Put all the sheets to print into the strSheets array
ReDim strSheets(0 To wkb.Sheets.Count - 1) As String

For i = 0 To wkb.Sheets.Count - 1
If (wkb.Sheets(i + 1).Range("A1").Value = True) Then
lngFound = lngFound + 1
strSheets(lngFound) = wkb.Sheets(i + 1).Name
End If
Next i

ReDim Preserve strSheets(0 To lngFound) As String

wkb.Sheets(strSheets).Select

End Sub
 
V

violet

Bob, for your i change the name to my sheet name already. somehow the module
still only apply to the sheet that is active and no tthe sheet that i have
defined.

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

Set wkb = ActiveWorkbook
For Each wks In wkb.Worksheets(Array("China", "Malaysia"))
Call changes
Next wks
End Sub

as for Bill, after the sheet is selected, then what to do next. where should
i call the sub in to apply the macro to the selected sheet. sorry for so many
problems as i really just started vba these few days, then my supervisor want
me do these.
 
H

halimnurikhwan

Hi Voilet,

Let me guess that u want to call changes in each WKS

Public Sub test_values_Master()
Dim wkb As Workbook
'Dim wks As Worksheet ' DEACTIVE IT IS IMPORTANT !
Set wkb = ActiveWorkbook
For Each wks In wkb.Worksheets(Array("China", "Malaysia"))
Call wks.changes ' Sub Changes should be there ...
Next wks
End Sub

Regards

Halim


violet menuliskan:
 
B

Bill Pfister

Sorry for not being explicit - I actually borrowed the code from a routine I
wrote to print the selected sheets. Hopefully this illustration is better.

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

Set wkb = ActiveWorkbook
For Each wks In wkb.Worksheets(Array("China", "Malaysia"))
' this next line assumes that you modified your test_values sub to
take in a parameter
call test_values( wks )
Next wks
end sub

Inside of test_values, you will either need to replace all references to
"ActiveSheet" or "ActiveWorksheet" with "wks" - this will ensure that the
operation is performed on the specified sheets.

Let me/us know if we can help further.

Regards,
Bill
 
V

violet

Bill Pfister said:
Sorry for not being explicit - I actually borrowed the code from a routine I
wrote to print the selected sheets. Hopefully this illustration is better.

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

Set wkb = ActiveWorkbook
For Each wks In wkb.Worksheets(Array("China", "Malaysia"))
' this next line assumes that you modified your test_values sub to
take in a parameter
call test_values( wks )
Next wks
end sub

Inside of test_values, you will either need to replace all references to
"ActiveSheet" or "ActiveWorksheet" with "wks" - this will ensure that the
operation is performed on the specified sheets.

Let me/us know if we can help further.

Regards,
Bill
 
V

violet

sorry.something happen n my post empty. i still cant get it to work.here my
code.bill i dun haf reference to the sheet in the sub.

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

Set wkb = ActiveWorkbook
For Each wks In wkb.Worksheets(Array("China", "Malaysia"))
Call changes(wks)
Next wks
End Sub

Sub changes(wks)
Call reset
Dim topCel As Range, bottomCel As Range, _
sourceRange As Range, targetRange As Range, compareRange As Range

Dim i As Integer, numofRows As Integer

If Cells(1, 24) <> 0 Then
Set topCel = Range("X2") 'For Dec
Set bottomCel = Range("X65536").End(xlUp)
If topCel.Row > bottomCel.Row Then End ' test if source range is empty
Set sourceRange = Range(topCel, bottomCel)
Set targetRange = Range("Y2")
Set compareRange = Range("W2")
else 'repeated coding for other cell'
End if

numofRows = sourceRange.Rows.Count
For i = 1 To numofRows
If sourceRange(i) <> compareRange(i) And sourceRange(i) <
compareRange(i) Then
targetRange(i) = "LEFT"
Rows(i + 1).Interior.ColorIndex = 4
Else
If sourceRange(i) <> compareRange(i) And sourceRange(i) >
compareRange(i) Then
targetRange(i) = "JOINED"
Rows(i + 1).Interior.ColorIndex = 6
End If
End If
Next
End Sub
 
B

Bill Pfister

When you use the "Cells" or "Range" objects, Excel assumes you want the
ActiveSheet.Cells or ActiveSheet.Range objects. You need to qualify which
Cells and Range objects you want to use. Look at the modifications I made to
your "changes" subroutine. I also get the feeling that your "Reset"
subroutine will need to qualify which sheets is works with.

Sub changes(wks As Worksheet)
Dim topCel As Range
Dim bottomCel As Range
Dim sourceRange As Range
Dim targetRange As Range
Dim compareRange As Range
Dim i As Integer
Dim numofRows As Integer

Call Reset


If (wks.Cells(1, 24) <> 0) Then
Set topCel = wks.Range("X2") 'For Dec
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 targetRange = wks.Range("Y2")
Set compareRange = wks.Range("W2")
Else 'repeated coding for other cell'
End If

numofRows = sourceRange.Rows.Count

For i = 1 To numofRows
If sourceRange(i) <> compareRange(i) And sourceRange(i) <
compareRange(i) Then
targetRange(i) = "LEFT"
wks.Rows(i + 1).Interior.ColorIndex = 4
Else
If sourceRange(i) <> compareRange(i) And sourceRange(i) >
compareRange(i) Then
targetRange(i) = "JOINED"
wks.Rows(i + 1).Interior.ColorIndex = 6
End If
End If
Next
End Sub
 
V

violet

Bill...really appreciate your help..thanks so much..w/o you, i will not be
able to solve it..thanks.....
 
V

violet

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
 
B

Bob Phillips

Can you show us the changes macro please Violet?

--
HTH

Bob Phillips

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

Bill Pfister

can you post the contents of the "changes" sub?


violet said:
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
 
V

violet

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
 
B

Bill Pfister

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
 

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