comparing two macros

[lior03]

hello
the first macro work perfectly - it loops through all sheets in a workbook
find the right sheet ( with the name specified ) and do what i asked it to do.

Dim oVBC As Object
Dim wb As Workbook
Application.StatusBar = "leghty macro ,please wait"
X = 2
For Each wb In Workbooks
If Not SheetExists("projects") Then
Worksheets.add.Name = "projects"
End If
For Each oVBC In Workbooks(wb.Name).VBProject.VBComponents
If Workbooks(wb.Name).VBProject.Protection = vbext_pp_none Then
Call GetCodeRoutines(wb.Name, oVBC.Name)
End If
Next
Next
With Sheets("projects")
.[A1].Resize(, 3).Value = Array("Workbook", "Module", "Procedures")
.[A2].Resize(UBound(aList, 2), UBound(aList, 1)).Value = _
Application.Transpose(aList)
.Columns("A:C").Columns.autofit
With Cells
.Font.Bold = True
.HorizontalAlignment = xlRight
Application.StatusBar = ""
End With
End With


the other macro on the other hand altough defined exactly like the previous one,fail to do it's job. namely-it do not execute the code at the sheet i want it to.it do at the active sheet.

Dim wb As Worksheet
For Each wb In Worksheets
If Not SheetExists("components") Then
Worksheets.add.Name = "components"
End If
With Sheets("components")
Cells.HorizontalAlignment = xlRight
Cells.ClearContents
Dim vbp As VBProject
Dim numcomponents As Integer
Dim i As Integer
Set vbp = ActiveWorkbook.VBProject
numcomponents = vbp.VBComponents.Count
Application.ScreenUpdating = False
On Error Resume Next
End With
Cells(1, 2) = "type"
Cells(1, 3) = "lines"
For i = 2 To numcomponents
Cells(i, 2) = vbp.VBComponents(i).Name
Select Case vbp.VBComponents(i).Type
Case 1
Cells(i, 3) = "module"
Case 2
Cells(i, 3) = "class module"
Case 3
Cells(i, 3) = "userform"
Case 100
Cells(i, 3) = "document module"
End Select
Cells(i, 3) = _
vbp.VBComponents(i).CodeModule.CountOfLines
Next i
Next


what is wrong with the second code?.how do i loop between all seets in a workbook?
thanks

[jindon]

Hi
isn't it like

Dim wb As Worksheet
Dim vbp As VBProject
Dim numcomponents As Integer
Dim i As Integer
Set vbp = ActiveWorkbook.VBProject
numcomponents = vbp.VBComponents.Count
Application.ScreenUpdating = False
On Error Resume Next
If Not SheetExists("components") Then
Worksheets.add.Name = "components"
End If
With Sheets("components")
Cells.HorizontalAlignment = xlRight
Cells.ClearContents
End With

For Each wb In Worksheets
with wb
.Cells(1, 2) = "type"
.Cells(1, 3) = "lines"
For i = 2 To numcomponents
.Cells(i, 2) = vbp.VBComponents(i).Name
Select Case vbp.VBComponents(i).Type
Case 1
.Cells(i, 3) = "module"
Case 2
.Cells(i, 3) = "class module"
Case 3
.Cells(i, 3) = "userform"
Case 100
.Cells(i, 3) = "document module"
End Select
.Cells(i, 3) = _
vbp.VBComponents(i).CodeModule.CountOfLines
Next i
end with
Next

[lior03]

hello
i tried it.it did not do it.the macro was executed on the activesheet.
i wanted it to look for a sheet named "components" and if it's not there to create one.it did not work.
thanks

[ALe]

Could be a problem related to sheetexists function?

[lior03]

the function syntex is:

Function SheetExists(sname) As Boolean
' Returns TRUE if sheet exists in the active workbook
Dim X As Object
On Error Resume Next
Set X = ActiveWorkbook.Sheets(sname)
If ERR = 0 Then SheetExists = True _
Else SheetExists = False
End Function


thanks

[ALe]

It worked on my PC. the problem is related to the existance or not of the sheet "components". If it not existing, macro creates it and it is the activesheet. If it is already existing, macro doesn't create it and it can be that the activesheet is another sheet.

To solve it, put the reference to the sheet before cells editing like...

but first of all be sure your function SheetExists is working




Dim wb As Worksheet
For Each wb In Worksheets
If Not SheetExists("components") Then
Worksheets.Add.Name = "components"
End If
With Sheets("components")
Cells.HorizontalAlignment = xlRight
Cells.ClearContents
Dim vbp As VBProject
Dim numcomponents As Integer
Dim i As Integer
Set vbp = ActiveWorkbook.VBProject
numcomponents = vbp.VBComponents.Count
Application.ScreenUpdating = False
On Error Resume Next
End With



Worksheets("components").Cells(1, 2) = "type"
Worksheets("components").Cells(1, 3) = "lines"
For i = 2 To numcomponents
Worksheets("components").Cells(i, 2) = vbp.VBComponents(i).Name
Select Case vbp.VBComponents(i).Type
Case 1
Worksheets("components").Cells(i, 3) = "module"
Case 2
Worksheets("components").Cells(i, 3) = "class module"
Case 3
Worksheets("components").Cells(i, 3) = "userform"
Case 100
Worksheets("components").Cells(i, 3) = "document module"
End Select
Worksheets("components").Cells(i, 3) = _
vbp.VBComponents(i).CodeModule.CountOfLines
Next i

Next

[ALe]

ok, the function is working. with my last code you shouldn't have any problems. I mean it works with me. let me know