problem in executing macro once for multiple worksheet
doesnt seem to work..gt error....i did declare the worksheet...my original
code work well if i do it worksheet by worksheet individualy. only problem is
when i try to code it for multiple worksheet den it got problem.
"Bob Phillips" wrote:
You are trying to pass a worksheet object to the macro, but not declaring
it, then usin g a hard-coded worksheet. Try
Sub sorting(setwks As Worksheet)
Dim topCel As Range, bottomCel As Range, _
sourceRange As Range, compareRange As Range
Dim x As Integer, i As Integer, numofRows As Integer
'Identify the corret column for comparing
Dim lngcol As Variant, lngreqcol As Variant, lngcomparecol As Variant
Dim namecol As String, strReqtopcell As String, _
strReqbotcell As String, strcomparecell As String
With setwks
namecol = setwks.Cells(3, 2).Value
lngcol = Asc(namecol) - Asc("A")
lngreqcol = lngcol + Asc("A")
strReqtopcell = Chr(lngreqcol) + "2"
strReqbotcell = Chr(lngreqcol) + "65536"
Set topCel = .Range(strReqtopcell)
Set bottomCel = .Range(strReqbotcell).End(xlUp)
If topCel.Row bottomCel.Row Then Exit Sub ' test if source range
is empty
Set sourceRange = .Range(topCel, bottomCel)
numofRows = sourceRange.Rows.Count
numofRows = sourceRange.Rows.Count
For i = numofRows To 1 Step -1
If sourceRange(i) = "Full Time Equivalents" Then
.Rows(i + 1).Cut
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
.Rows(iLastRow + 1).Insert Shift:=xlDown
End If
Next
End With
End Sub
--
HTH
Bob Phillips
(replace somewhere in email address with gmail if mailing direct)
"violet" wrote in message
...
hi bob...here the code
Sub sorting()
Dim topCel As Range, bottomCel As Range, _
sourceRange As Range, compareRange As Range
Dim x As Integer, i As Integer, numofRows As Integer
'Identify the corret column for comparing
Dim setwks As Worksheet
Set setwks = Worksheets("Settings")
Dim lngcol As Variant, lngreqcol As Variant, lngcomparecol As Variant
Dim namecol As String, strReqtopcell As String, strReqbotcell As
String, _
strcomparecell As String
namecol = setwks.Cells(3, 2).Value
lngcol = Asc(namecol) - Asc("A")
lngreqcol = lngcol + Asc("A")
strReqtopcell = Chr(lngreqcol) + "2"
strReqbotcell = Chr(lngreqcol) + "65536"
Set topCel = Range(strReqtopcell)
Set bottomCel = Range(strReqbotcell).End(xlUp)
If topCel.Row bottomCel.Row Then Exit Sub ' test if source range is
empty
Set sourceRange = Range(topCel, bottomCel)
numofRows = sourceRange.Rows.Count
numofRows = sourceRange.Rows.Count
For i = numofRows To 1 Step -1
If sourceRange(i) = "Full Time Equivalents" Then
Rows(i + 1).Cut
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Rows(iLastRow + 1).Select
Selection.Insert Shift:=xlDown
Else
End If
Next
End Sub
"Bob Phillips" wrote:
Show the code from one of those two
--
HTH
Bob Phillips
(replace somewhere in email address with gmail if mailing direct)
"violet" wrote in message
...
Public Sub Workbook_Open()
Dim wkb As Workbook
Dim wks As Worksheet
Set wkb = ActiveWorkbook
For Each wks In wkb.Worksheets(Array("Koram", "Hong_Kong",
"Korea",
"China", "Malaysia", "Brunei", "Indonesia", _
"Philippines", "Singapore", "Thailand", "Taiwan", "Vietnam",
"HUB",
"India", "Sri_Lanka", "Bangladesh"))
Call sorting(wks)
Call SubTot(wks)
Call changes(wks)
Next wks
end sub
this code work well for changes(wks). when i add in the other 2, the
macro
will not be apply to all required sheets but only apply to one sheet.
what
i
m lacking here?
|