View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Jamie Collins Jamie Collins is offline
external usenet poster
 
Posts: 593
Default counting the rows that match in my loop

andycharger wrote ...

My code is taking forever to run. I have a looping statement that has
about 6 or 7 nested if statements.


You are correct, a loop will be slow. If you need the count, try the
following approach:

This code in a standard module in the workbook containing the data
(assumes the data is on the active sheet. Review the variable
assignments for proper values e.g.

strBranch = "a"
strRef = "a"
etc

to match your data.

' --- code ---
Option Explicit

Sub Test()

Dim strBranch As String
Dim strRef As String
Dim strPCode As String
Dim strRegNo As String
Dim strTranDate As String
Dim strTranType As String

strBranch = "a"
strRef = "a"
strPCode = "a"
strRegNo = "a"
strTranDate = "a"
strTranType = "a"

Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim Target As Excel.Range
Dim Con As Object
Dim rs As Object
Dim strCon As String
Dim strPath As String
Dim strSql1 As String
Dim lngCount As Long

' Amend the following constants to suit
Const FILENAME_XL_TEMP As String = "" & _
"delete_me.xls"
Const TABLE_NAME_NEW As String = "" & _
"MyNewTable"

' Do NOT amend the following constants
Const CONN_STRING_1 As String = "" & _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=<PATH<FILENAME;" & _
"Extended Properties='Excel 8.0;HDR=NO;IMEX=1'"

' Build connection strings
strPath = ThisWorkbook.Path & _
Application.PathSeparator

strCon = CONN_STRING_1
strCon = Replace(strCon, _
"<PATH", strPath)
strCon = Replace(strCon, _
"<FILENAME", FILENAME_XL_TEMP)

' Build sql statement
strSql1 = ""
strSql1 = strSql1 & "SELECT COUNT(*) FROM "
strSql1 = strSql1 & " [" & TABLE_NAME_NEW & "$A1:K65536]"
strSql1 = strSql1 & " WHERE F1='" & strBranch & "'"
strSql1 = strSql1 & " AND F2='" & strRef & "'"
strSql1 = strSql1 & " AND F5='" & strPCode & "'"
strSql1 = strSql1 & " AND F9='" & strRegNo & "'"
strSql1 = strSql1 & " AND F10='" & strTranDate & "'"
strSql1 = strSql1 & " AND F11='" & strTranType & "'"

' Delete old instance of temp workbook
On Error Resume Next
Kill strPath & FILENAME_XL_TEMP
On Error GoTo 0

' Save copy of worksheet to temp workbook
Excel.Application.ScreenUpdating = False
Set ws = ActiveSheet
Set wb = Excel.Application.Workbooks.Add()
With wb
ws.Copy .Worksheets(1)
.Worksheets(1).Name = TABLE_NAME_NEW
.SaveAs strPath & FILENAME_XL_TEMP
.Close
End With
Excel.Application.ScreenUpdating = True

' Open connection to temp workbook
Set Con = CreateObject("ADODB.Connection")
With Con
.ConnectionString = strCon
.Open
Set rs = .Execute(strSql1)
lngCount = rs.Fields(0).Value
.Close
End With

MsgBox CStr(lngCount) & " rows."

End Sub
' --- code ends ---

Jamie.

--