Get only Sub names - excel

Question

Using below code I am getting both Sub names and functions name, but I want only Sub names excluding function names, please suggest me for this, it will be really helpful for me
Sub ListMacros()
Dim VBComp As VBComponent
Dim VBCodeMod As CodeModule
Dim oListsheet As Object
Dim StartLine As Long
Dim ProcName As String
Dim iCount As Integer
Application.ScreenUpdating = False
On Error Resume Next
Set oListsheet = ActiveWorkbook.Worksheets.Add
iCount = 1
oListsheet.[a1] = "Macro"
For Each VBComp In ThisWorkbook.VBProject.VBComponents
Set VBCodeMod = ThisWorkbook.VBProject.VBComponents(VBComp.Name).CodeModule
With VBCodeMod
StartLine = .CountOfDeclarationLines + 1
Do Until StartLine >= .CountOfLines
oListsheet.[a1].Offset(iCount, 0).Value = _
.ProcOfLine(StartLine, vbext_pk_Proc)
iCount = iCount + 1
StartLine = StartLine + _
.ProcCountLines(.ProcOfLine(StartLine, _
vbext_pk_Proc), vbext_pk_Proc)
Loop
End With
Set VBCodeMod = Nothing
Next VBComp
Application.ScreenUpdating = True
End Sub

Answer 1

Please add this lines:
If InStr(.Lines(StartLine, 2), "Function") = 0 Then
iCount = iCount + 1
End If
'2 lines because sometimes it returns "" for only a line (from unknown reasons)...
after
oListsheet.[a1].Offset(iCount, 0).Value = _
.ProcOfLine(StartLine, vbext_pk_Proc)
Edited, to return the standard module type, too:
If InStr(.Lines(StartLine, 2), "Function") = 0 Then
If VBComp.Type = 1 Then
oListsheet.[a1].Offset(iCount, 1).Value = VBComp.Name
End If
iCount = iCount + 1
End If

Answer 2

' *****************************************************************************************
' Connect to Siebel
' *****************************************************************************************
Function WriteCell(iRow As Integer, iCol As Integer, iColor As Integer, Msg As String)
ViewsSheet.Cells(iRow, iCol).Font.ColorIndex = iColor
ViewsSheet.Cells(iRow, iCol).Value = Msg
End Function
Sub ListMacros()
Application.DisplayAlerts = False
ActiveWorkbook.Save
Dim VBComp As VBComponent
Dim VBCodeMod As CodeModule
Dim oListsheet As Object
Dim StartLine As Long
Dim ProcName As String
Dim iCount As Integer
Application.ScreenUpdating = False
On Error Resume Next
Set oListsheet = ActiveWorkbook.Worksheets.Add
oListsheet.Name = "MacroList"
iCount = 0
oListsheet.[a1] = ""
For Each VBComp In ThisWorkbook.VBProject.VBComponents
Set VBCodeMod = ThisWorkbook.VBProject.VBComponents(VBComp.Name).CodeModule
With VBCodeMod
StartLine = .CountOfDeclarationLines + 1
Do Until StartLine >= .CountOfLines
oListsheet.[a1].Offset(iCount, 0).Value = .ProcOfLine(StartLine, vbext_pk_Proc)
'If InStr(.Lines(StartLine, 2), "Function") = 0 Then
iCount = iCount + 1
'End If
StartLine = StartLine + .ProcCountLines(.ProcOfLine(StartLine, vbext_pk_Proc), vbext_pk_Proc)
Loop
End With
Set VBCodeMod = Nothing
Next VBComp
Application.ScreenUpdating = True
Dim FilePath As String
Dim CellData As String
Dim LastCol As Long
Dim LastRow As Long
Dim i As Long
Dim j As Long
LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
CellData = ""
FilePath = "E:\Dir\Excel\MacroTxt\\MacroList2.txt"
Open FilePath For Output As #2
For i = 1 To LastRow
For j = 1 To LastCol
If j = LastCol Then
CellData = CellData + Trim(ActiveCell(i, j).Value)
Else
CellData = CellData + Trim(ActiveCell(i, j).Value) + ","
End If
Next j
Write #2, CellData
CellData = ""
Next i
Close #2
Application.DisplayAlerts = False
End Sub