ExcelBanter - Filtered counts

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Filtered counts (https://www.excelbanter.com/excel-programming/306943-filtered-counts.html)

Can anyone please tell me how i can count the number of rows o
worksheet "Raw" that contain the text "Acorn" in column "E" but only i
the cell in column "V" is not empty.

Also i would like to copy the row that meets the above criteria to
new worksheet called "Checked"

TI

--
Message posted from http://www.ExcelForum.com

Hi
try
=SUMPRDUCT(--(E1:E1000="Acorn"),--(V1:V1000<""))

For more about SUMPRODUCT see:
http://www.xldynamic.com/source/xld.SUMPRODUCT.html

--
Regards
Frank Kabel
Frankfurt, Germany

"Jako " schrieb im Newsbeitrag
...
Can anyone please tell me how i can count the number of rows on
worksheet "Raw" that contain the text "Acorn" in column "E" but only
if
the cell in column "V" is not empty.

Also i would like to copy the row that meets the above criteria to a
new worksheet called "Checked"

TIA

---
Message posted from http://www.ExcelForum.com/

Thanks for the reply.

Is there a way to do it as a VBA macro / Subroutine?

Also i woould like to then create an Add-in for this and other simila
processes.

Is it the case that they must all be programmed as functions to be abl
to use them as Add-Ins?

Thank

--
Message posted from http://www.ExcelForum.com

Hi
why do you want to do it within VBA? this would probably slower!

--
Regards
Frank Kabel
Frankfurt, Germany

"Jako " schrieb im Newsbeitrag
...
Thanks for the reply.

Is there a way to do it as a VBA macro / Subroutine?

Also i woould like to then create an Add-in for this and other
similar
processes.

Is it the case that they must all be programmed as functions to be
able
to use them as Add-Ins?

Thanks

---
Message posted from http://www.ExcelForum.com/

Don't i have to do it in VBA to create an Add-in that i can share on
numerous computers to people with very basic Excel knowledge?

---
Message posted from http://www.ExcelForum.com/

You could loop through the range or use just evaluate the worksheet function:

MsgBox _
ActiveSheet.Evaluate("=SUMPRoDUCT(--(E1:E1000=""Acorn""),--(V1:V1000<""""))")

(I added the "o" in sumproduct. <vbg)

"Jako <" wrote:

Don't i have to do it in VBA to create an Add-in that i can share on
numerous computers to people with very basic Excel knowledge?

---
Message posted from http://www.ExcelForum.com/

--

Dave Peterson

Is this possible, and if so, how will i put it as an Add-In

--
Message posted from http://www.ExcelForum.com

Depends on what your addin is going to do with it.

If you just want to show it to the user, then you can use the msgbox.

If you're going to do something else with the value,

sub testme
dim myVal as long
myval = _
ActiveSheet.Evaluate("=SUMPRoDUCT(--(E1:E1000=""Acorn""),--(V1:V1000<""""))")
'do what you want after that
end sub

"Jako <" wrote:

Is this possible, and if so, how will i put it as an Add-In?

---
Message posted from http://www.ExcelForum.com/

--

Dave Peterson

Many thanks that works a treat.

Please could you tell me how i can then use this to check all th
worksheets of any workbooks in a folder called Audit on the C:.
ie C:/Audit.

What i want to do is check each workbook (all worksheet therein) i
this directory using the function you have provided.

TI

--
Message posted from http://www.ExcelForum.com

Open each of the workbooks and then evaluate the function for each worksheet:

Option Explicit
Sub testme01()

Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim tempWkbk As Workbook
Dim wks As Worksheet
Dim myVal As Long
Dim oRow As Long
Dim RptWks As Worksheet

'change to point at the folder to check
myPath = "c:\my documents\excel\test"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

Application.ScreenUpdating = False

Set RptWks = Workbooks.Add(1).Worksheets(1)
RptWks.Range("a1").Resize(1, 3).Value _
= Array("workbook Name", "worksheet Name", "value")

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then
oRow = 2
For fCtr = LBound(myFiles) To UBound(myFiles)
Application.StatusBar = "Processing: " & myFiles(fCtr)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myFiles(fCtr))
For Each wks In tempWkbk.Worksheets
myVal = _
wks.Evaluate("=SUMPRoDUCT(--(E1:E1000=""Acorn"")," & _
"--(V1:V1000<""""))")
With RptWks.Cells(oRow, "A")
.Value = tempWkbk.FullName
.Offset(0, 1).Value = "'" & wks.Name
.Offset(0, 2).Value = myVal
End With
oRow = oRow + 1
Next wks
tempWkbk.Close savechanges:=False
Next fCtr
End If

With RptWks
.UsedRange.Columns.AutoFit
End With

With Application
.ScreenUpdating = True
.StatusBar = False
End With

End Sub

"Jako <" wrote:

Many thanks that works a treat.

Please could you tell me how i can then use this to check all the
worksheets of any workbooks in a folder called Audit on the C:.
ie C:/Audit.

What i want to do is check each workbook (all worksheet therein) in
this directory using the function you have provided.

TIA

---
Message posted from http://www.ExcelForum.com/

--

Dave Peterson

Have you thought about laying out the report so that the workbook name and
worksheet name appears only once--and the values for the words you're looking
for go across.

If you think you'd like that layout try this:

Option Explicit
Option Base 0
Sub testme01()

Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim tempWkbk As Workbook
Dim wks As Worksheet
Dim myVal As Long
Dim oRow As Long
Dim RptWks As Worksheet
Dim myWords As Variant
Dim wdCtr As Long

myWords = Array("Topshot Ltd", "Acorn", "Caddick", "Morrison", "Lantel")

'change to point at the folder to check
myPath = "c:\my documents\excel\test"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "NO FILES FOUND AT THIS LOCATION !!"
Exit Sub
End If

Application.ScreenUpdating = False

Set RptWks = Workbooks.Add(1).Worksheets(1)
With RptWks
.Range("a1").Resize(1, 2).Value _
= Array("WORKBOOK NAME", "WORKSHEET NAME")

.Range("C1").Resize(1, UBound(myWords) - LBound(myWords) + 1).Value _
= myWords
End With

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then
oRow = 2
For fCtr = LBound(myFiles) To UBound(myFiles)
Application.StatusBar = "Processing: " & myFiles(fCtr)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myFiles(fCtr))
For Each wks In tempWkbk.Worksheets
With RptWks.Cells(oRow, "A")
.Value = tempWkbk.FullName
.Offset(0, 1).Value = "'" & wks.Name
End With
For wdCtr = LBound(myWords) To UBound(myWords)
myVal = _
wks.Evaluate("=SUMPRoDUCT(--(G1:G10000=""" _
& myWords(wdCtr) & """)," & _
"--(V1:V10000<""""))")

RptWks.Cells(oRow, "A").Offset(0, 2 + wdCtr).Value = myVal
Next wdCtr
oRow = oRow + 1
Next wks
tempWkbk.Close savechanges:=False
Next fCtr
End If

With RptWks
.UsedRange.Columns.AutoFit
End With

With Application
.ScreenUpdating = True
.StatusBar = False
End With

End Sub

And if you really want one line per word per worksheet per workbook, I wouldn't
lay it out quite the way you suggested.

I'd put the word on each row (column A??). By having it on each line, I could
use Data|filter|autofilter. I could do charts and graphs, I could do
data|pivottable much easier.

Here's the second version:

Option Explicit
Option Base 0
Sub testme01()

Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim tempWkbk As Workbook
Dim wks As Worksheet
Dim myVal As Long
Dim oRow As Long
Dim RptWks As Worksheet
Dim myWords As Variant
Dim wdCtr As Long

myWords = Array("Topshot Ltd", "Acorn", "Caddick", "Morrison", "Lantel")

'change to point at the folder to check
myPath = "c:\my documents\excel\test"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "NO FILES FOUND AT THIS LOCATION !!"
Exit Sub
End If

Application.ScreenUpdating = False

Set RptWks = Workbooks.Add(1).Worksheets(1)
With RptWks
.Range("a1").Resize(1, 4).Value _
= Array("Word", "WORKBOOK NAME", "WORKSHEET NAME", "VALUE")
End With

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then
oRow = 2
For fCtr = LBound(myFiles) To UBound(myFiles)
Application.StatusBar = "Processing: " & myFiles(fCtr)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myFiles(fCtr))
For Each wks In tempWkbk.Worksheets
For wdCtr = LBound(myWords) To UBound(myWords)
myVal = _
wks.Evaluate("=SUMPRoDUCT(--(G1:G10000=""" _
& myWords(wdCtr) & """)," & _
"--(V1:V10000<""""))")
With RptWks.Cells(oRow, "A")
.Value = myWords(wdCtr)
.Offset(0, 1).Value = tempWkbk.FullName
.Offset(0, 2).Value = "'" & wks.Name
.Offset(0, 3).Value = myVal
End With
oRow = oRow + 1
Next wdCtr

Next wks
tempWkbk.Close savechanges:=False
Next fCtr
End If

With RptWks
.UsedRange.Columns.AutoFit
With .Range("a:d")
.Sort key1:=.Columns(1), order1:=xlAscending, header:=xlYes
End With
End With

With Application
.ScreenUpdating = True
.StatusBar = False
End With

End Sub

(And remember to change the path!)

<<snipped

--

Dave Peterson

FANTASTIC !!

Many thanks that's perfect and far better than what i was asking for a
well.
Thankyou again for all your advice and time

--
Message posted from http://www.ExcelForum.com