Here's the final code I came up with, and it works very nicely. But
first, I want to thank everyone that posted, your comments and
suggestions led to things working in the end.
Imports Microsoft.Office.Interop.Excel
Public Class Calculate
Public Sub Perform(ByVal application As Application)
Try
application.Cursor = XlMousePointer.xlWait
application.StatusBar = "Calculating ..."
Dim Range1 As Microsoft.Office.Interop.Excel.Range
'Dim cell As Range
Dim PPS, PPH, IMAC, Netwrk, Srvr, Info, FAC, Account, SAP,
LicInst, Obr As Integer
Dim sTot As String
Dim Found As Boolean
' Init variables to 0 just in case
PPS = 0
PPH = 0
IMAC = 0
Netwrk = 0
Srvr = 0
Info = 0
FAC = 0
Account = 0
SAP = 0
LicInst = 0
Obr = 0
' Remember the cells the user selected before?
Range1 = application.Selection
'Check to see if the user selected anything, I'll use less
than 5
If Range1.Cells.Count < 5 Then Throw New Exception("You
must select a column to process")
' Set our variables
Dim nRows As Integer
Dim nCols As Integer
Dim regx As New System.Text.RegularExpressions.Regex("")
For nRows = 1 To Range1.Rows.Count
Dim s As String = Range1.Cells(nRows, 1).Value
If (Not s Is Nothing) Or (Not s = "") Then
' Find all SOFTWARE except SAP
If regx.IsMatch(s,
"\b(PPS|SOFTWARE)\b.(?!\b(SAP)\b)") Then PPS += 1
' Find all HARDWARE
If regx.IsMatch(s, "(\bPPH\b)|(\bHARDWARE\b)") Then
PPH += 1
' Find ONLY SAP
If regx.IsMatch(s, "(\bSAP\b)") Then SAP += 1
' Find ONLY IMAC
If regx.IsMatch(s,
"\b(PI|IMAC|PI[A-Z])\b.(?!\b(LIC)\b)") Then IMAC += 1
' Find O BACKUP/RESTORE
If regx.IsMatch(s, "\b(O)\b.*") Then Obr += 1
' Find NETWORK
If regx.IsMatch(s, "\b(N)\b.*") Then Netwrk += 1
' Find ACCOUNT
If regx.IsMatch(s, "\b(A)\b.*") Then Account += 1
' Find LIC INST
If regx.IsMatch(s, "\b(LIC)\b.(\b(INST)\b)") Then
LicInst += 1
' Find FACILITIES
If regx.IsMatch(s, "\b(FACILITIES)\b") Then FAC += 1
' Find INFO
If regx.IsMatch(s, "\b(INFO)\b") Then Info += 1
' Find all SERVER
If regx.IsMatch(s,
"((\bSP[A-Z]\b)|(\bS\b)|(\bS[A-Z]\b)|(\bSERVER\b))") Then Srvr += 1
End If
' Calculate the percentage complete
sTot = "Calculating " &
Decimal.Round(Decimal.Multiply(Decimal.Divide(CDec(nRows),
CDec(Range1.Rows.Count)), 100), 0) & "%"
' Solve "Flickering" problem in Status Bar
If Not application.StatusBar = sTot Then
application.StatusBar = sTot
Next
Dim ws As Worksheet
ws = application.Workbooks(1).Worksheets.Add()
ws.Name = "Results"
' Setup our labels
With ws
.Cells(1, 1).Value = "SOFTWARE"
.Cells(2, 1).Value = "HARDWARE"
.Cells(3, 1).Value = "IMAC"
.Cells(4, 1).Value = "SAP"
.Cells(5, 1).Value = "SERVER (SP)"
.Cells(6, 1).Value = "LIC INST"
.Cells(7, 1).Value = "ACCOUNT"
.Cells(8, 1).Value = "INFO"
.Cells(9, 1).Value = "BACKUP/RESTORE"
.Cells(10, 1).Value = "NETWORK"
.Cells(11, 1).Value = "FACILITIES"
.Cells(13, 1).Value = "Totals"
End With
ws.Range("A1:A13").Select()
With application.Selection
With .Font
.Name = "Times New Roman"
.FontStyle = "Regular"
.Size = 14
End With
.Columns.Autofit()
End With
' Add our data
With ws
.Cells(1, 2).Value = PPS
.Cells(2, 2).Value = PPH
.Cells(3, 2).Value = IMAC
.Cells(4, 2).Value = SAP
.Cells(5, 2).Value = Srvr
.Cells(6, 2).Value = LicInst
.Cells(7, 2).Value = Account
.Cells(8, 2).Value = Info
.Cells(9, 2).Value = Obr
.Cells(10, 2).Value = Netwrk
.Cells(11, 2).Value = FAC
.Cells(13, 2).Value = PPS + PPH + Obr + SAP + Netwrk +
Account + LicInst + FAC + Info
End With
ws.Range("B1:B13").Select()
With application.Selection
With .Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 12
End With
.Columns.Autofit()
End With
ws.Activate()
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Plugin Error")
Finally
application.Cursor = XlMousePointer.xlDefault
application.StatusBar = "Ready"
End Try
End Sub
End Class
The RegEx cuts out alot of Select Case/If Then code, which ended up
being 100+ lines of code.
I'm most likely going to write up an article and post it on CodeProject
so that others can use this as well.
Thank you all again,
Jody W