Code:
Sub CountNSEW()
Open "C:\Count.csv" For Output As #1
Dim SSetTexts As AcadSelectionSet
On Error Resume Next
Set SSetTexts = ThisDrawing.SelectionSets.Add("SSET_TEXTS")
If Err Then
Set SSetTexts = ThisDrawing.SelectionSets("SSET_TEXTS")
SSetTexts.Clear
End If
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
FilterType(0) = 0
FilterData(0) = "TEXT"
SSetTexts.SelectOnScreen FilterType, FilterData
Dim NSStrings As String
Dim EWStrings As String
Dim xText As AcadText
For Each xText In SSetTexts
Ts = xText.TextString
Select Case xText.Layer
Case "EW"
EWStrings = EWStrings & xText.TextString & " "
Case "NS"
NSStrings = NSStrings & xText.TextString & " "
End Select
Next
Print #1, """NS"" Layer Quantities..."
Print #1, "25,30,35,40,45,50,55,60" 'and so on
Print #1, CountStr("25", NSStrings) & "," & CountStr("30", NSStrings) & "," & CountStr("35", NSStrings) _
& "," & CountStr("40", NSStrings) & "," & CountStr("45", NSStrings) & "," & CountStr("50", NSStrings) _
& "," & CountStr("55", NSStrings) & "," & CountStr("60", NSStrings) 'and so on
Print #1,
Print #1, """EW"" Layer Quantities..."
Print #1, "25,30,35,40,45,50,55,60" 'and so on
Print #1, CountStr("25", EWStrings) & "," & CountStr("30", EWStrings) & "," & CountStr("35", EWStrings) _
& "," & CountStr("40", EWStrings) & "," & CountStr("45", EWStrings) & "," & CountStr("50", EWStrings) _
& "," & CountStr("55", EWStrings) & "," & CountStr("60", EWStrings) 'and so on
Close #1
AppID = Shell("C:\Program Files (x86)\Microsoft Office\Office12\EXCEL.EXE C:\Count.csv", 3) 'modify with your excel path
AppActivate AppID, False
Application.WindowState = acMin
End Sub
Function CountStr(StrToCount As String, strToSearch As String) As Integer
Dim StringsArray As Variant
StringsArray = Split(strToSearch)
For i = 0 To UBound(StringsArray)
If StringsArray(i) = StrToCount Then
CountStr = CountStr + 1
End If
Next
End Function
Modify as per your requirements. Good luck.