SumProduct problem

[Gil D.]

Hello,

I wrote a function which is using SumProduct.

a is a worksheet range
b is a worksheet cell
c is a worksheet range

Function cond_average(a, b, c)

If Application.SumProduct(--(a = b), --(c <> "")) = 0 Then
cond_average = -1
Else
cond_average = Application.SumIf(a, b, c) / Application.CountIf(a,
b)
End If

End Function

Sumif and CountIf functions works but SumProduct returns error.

What is wrong ?

thank you
Gil D.

[daddylonglegs]

For SUMPRODUCT to work a and c should not be whole columns and must be the same size

[Gil D.]

Hello,

Thank you for your answer.

a and c are not whole columns and they have the same size.

For example:
a is worksheet1!A1:A15
c is worksheet1!C1:C15
b is worksheet2!A5

When I insert the SumProduct formula to worksheet cell it works. I get
an error only when trying to use it in VBA.

Can something else be wrong ?

Thank you
Gil D.

[Gil D.]

Hello,

I call my function like this:
=cond_average(Sheet1!A1:A15,Sheet2!A5,Sheet1!C1:C15)

I am using excel XP.

What can be wrong ?

Thank you
Gil D.

[Tom Ogilvy]

Unfortunately, it won't work even with that restriction.

Sumproduct can not be evaluated as an array formula (as you are trying to
do) by using application.Sumproduct in VBA.
You will need to build the formula the same as you would in a worksheet cell
and use the evaluate function

If Evaluate("SumProduct(--(A1:A500=B1:B500), --(C1:C500 <> """"))") = 0 Then

demo's from the immediate window:

? Evaluate("SumProduct(--(A1:A500=B1:B500), --(C1:C500 <> """"))")
2

two is the expected answer for the test data I set up.

--
Regards,
Tom Ogilvy


"daddylonglegs" <[email protected]>
wrote in message
news:[email protected]...
>
> For SUMPRODUCT to work a and c should not be whole columns and must be
> the same size
>
>
> --
> daddylonglegs
> ------------------------------------------------------------------------
> daddylonglegs's Profile:
http://www.excelforum.com/member.php...o&userid=30486
> View this thread: http://www.excelforum.com/showthread...hreadid=511574
>

[Tom Ogilvy]

Function cond_average(a, b, c)
Dim sStr as String
sStr = "Sumproduct(--(" & a.address & _
"=" & b.Address(0,0) & "),--(" & c.address & _
"<>""""))"
If Evaluate(sStr) = 0 Then
cond_average = -1
Else
cond_average = Application.SumIf(a, b, c) / _
Application.CountIf(a,b)
End If
End Function


--
Regards,
Tom Ogilvy

"Gil D." <[email protected]> wrote in message
news:[email protected]...
> Hello,
>
> I call my function like this:
> =cond_average(Sheet1!A1:A15,Sheet2!A5,Sheet1!C1:C15)
>
> I am using excel XP.
>
> What can be wrong ?
>
> Thank you
> Gil D.
>

[Bob Phillips]

Try this

If ActiveSheet.Evaluate("SumProduct(--(sheet1!A1:A15=sheet2!A5)," & _
"--(sheet1!C1:C15<>""""))") = 0 Then
cond_average = -1
Else
cond_average = Application.SumIf(a, b, c) / Application.CountIf(a, b)
End If


--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"Gil D." <[email protected]> wrote in message
news:[email protected]...
> Hello,
>
> I wrote a function which is using SumProduct.
>
> a is a worksheet range
> b is a worksheet cell
> c is a worksheet range
>
> Function cond_average(a, b, c)
>
> If Application.SumProduct(--(a = b), --(c <> "")) = 0 Then
> cond_average = -1
> Else
> cond_average = Application.SumIf(a, b, c) / Application.CountIf(a,
> b)
> End If
>
> End Function
>
> Sumif and CountIf functions works but SumProduct returns error.
>
> What is wrong ?
>
> thank you
> Gil D.
>

[Pingle Phil]

Bob Phillips wrote:
> Try this
>
> If ActiveSheet.Evaluate("SumProduct(--(sheet1!A1:A15=sheet2!A5)," & _
> "--(sheet1!C1:C15<>""""))") = 0 Then
> cond_average = -1
> Else
> cond_average = Application.SumIf(a, b, c) / Application.CountIf(a, b)
> End If
>
>
> --
> HTH
>
> Bob Phillips
>
> (remove nothere from email address if mailing direct)
>
> "Gil D." <[email protected]> wrote in message
> news:[email protected]...
> > Hello,
> >
> > I wrote a function which is using SumProduct.
> >
> > a is a worksheet range
> > b is a worksheet cell
> > c is a worksheet range
> >
> > Function cond_average(a, b, c)
> >
> > If Application.SumProduct(--(a = b), --(c <> "")) = 0 Then
> > cond_average = -1
> > Else
> > cond_average = Application.SumIf(a, b, c) / Application.CountIf(a,
> > b)
> > End If
> >
> > End Function
> >
> > Sumif and CountIf functions works but SumProduct returns error.
> >
> > What is wrong ?
> >
> > thank you
> > Gil D.
> >

I have a similar problem to this but I cannot get the countif function
to look at the correct worksheet. Any chance of some help on this?

I have a blank workbook with the macro being run after choosing 2 file
names.
File 1 = a list of item that require additional data adding to the
columns
File 2 = is the additional data that is required.

The unique identifier is a combination of the items dimensions and what
its used for
I can fid the item Ok with the find statement but if the item does not
exist it throws an error. That is why I am trying the Countif to see if
the item exists.
The countif always looks at the workbook that the macro is in.
As I have only been doing VBA code a 2 weeks I have included all the
code.

Private Sub ImportEstimate(ByVal strFilename As String, strProfiles As
String)

Dim vXlsApplication As Excel.Application
Dim vWorkbookObj As Workbook
Dim vWorksheetObj As Excel.Worksheet
' Dim pXlsApplication As Excel.Application
Dim pWorkbookObj As Workbook
Dim pWorksheetObj As Excel.Worksheet
Dim IntSheetNum As Integer
Dim IntSheet As Integer
Dim IntNumOfRows As Integer
Dim IntTheRow As Integer
Dim IntNumVars As Integer
Dim IntNumProfile As Integer
Dim x As Integer
Dim i As Integer
Dim BottomCel As String
Dim SourceRange
Dim WorkSheetName As String
Dim Message As String
Dim TheText As String
Dim TheReply As String
Dim TheData As String
Dim Profile As String
Dim PrevProfile As String


On Error GoTo localErr
With vXlsApplication
'Open the VMI File
Set vXlsApplication = New Excel.Application


' Open the profiles spreadsheet
' Set pXlsApplication = New Excel.Application
' See if the file is already open
If Not WorkbookOpen(strProfiles) Then
Set pWorkbookObj = vXlsApplication.Workbooks.Open(strProfiles)
Set pWorksheetObj = pWorkbookObj.Worksheets(1)
pWorksheetObj.Activate
vXlsApplication.Visible = True
End If

'Open the data File
' See if the file is already open
If Not WorkbookOpen(strFilename) Then
Set vWorkbookObj = vXlsApplication.Workbooks.Open(strFilename)
' vXlsApplication.Visible = True

End If

IntSheetNum = vWorkbookObj.Worksheets.Count
For IntSheet = 1 To IntSheetNum
Set vWorksheetObj = vWorkbookObj.Worksheets(IntSheet)
vWorksheetObj.Activate
WorkSheetName = vWorksheetObj.Name

If LCase(WorkSheetName) = "backs" Then GoTo foundSheet

Next ' IntSheet

GoTo localErr ' We will only get here if the worksheet is not found

foundSheet:


IntNumOfRows = vWorksheetObj.UsedRange.Rows.Count
BottomCel = "A" + CStr(IntNumOfRows)
If IntNumOfRows < 2 Then End ' test if source range is empty
Set SourceRange = vWorksheetObj.Range("A2", BottomCel)

TheReply = ""
x = 1
'Start at 4 as we cant be bothered to do the headings
For i = 3 To IntNumOfRows

If Profile = "" Then
TheData = "AP" + CStr(i) + ":AP" + CStr(i)
Profile = Trim(LCase(vWorksheetObj.Range(TheData)))
TheData = "Aq" + CStr(i) + ":Aq" + CStr(i)
Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
TheData = "Ar" + CStr(i) + ":Ar" + CStr(i)
Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
TheData = "As" + CStr(i) + ":As" + CStr(i)
Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
TheData = "AT" + CStr(i) + ":AT" + CStr(i)
Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
End If
If Profile <> "" Then IntNumVars = IntNumVars + 1

If i = 4 Then MsgBox Profile + " w " + TheReply ' For debuging

' On Error GoTo Ignore
With pWorksheetObj
If Profile <> "" And Left(Profile, 5) <> "brand" And TheReply =
"" Then
' GoTo CleanUp
IntNumProfile = WorksheetFunction.CountIf(Columns("m:m"),
Profile)
IntNumProfile = WorksheetFunction.CountIf(Columns(12), "Phils
thing")
IntTheRow = 0
If Profile <> "" And IntNumProfile <> 0 Then

IntTheRow = pWorksheetObj.Columns("H").Find(Profile,
LookIn:=xlValues, lookat:=xlWhole).Row
End If 'count if
If IntTheRow <> 0 Then
TheData = "H" + CStr(IntTheRow)
TheReply = pWorksheetObj.Range(TheData).Value
MsgBox Profile + " " + TheReply
End If ' If IntTheRow <> 0
End If ' The profile
End With ' pWorkSheetObj
If Profile = "" Then Profile = PrevProfile

If i = 4 Then MsgBox Profile + " q " + TheReply

' Now see if its the end of the product group
TheData = "B" + CStr(i)
TheText = Trim(LCase(vWorksheetObj.Range(TheData)))
If TheText = "total" Then
If TheReply = "" Then
' MsgBox "No parameter details found " + Profile
TheData = "AU" + CStr(i)
vWorksheetObj.Range(TheData).Value = "No Profile found"
TheData = "AV" + CStr(i)
vWorksheetObj.Range(TheData).Value = IntNumVars
TheData = "Aw" + CStr(i)
vWorksheetObj.Range(TheData).Value = Profile
IntNumVars = 0
Profile = ""
TheReply = ""
GoTo Ignore
End If ' thereply = ""
TheData = "AU" + CStr(i)
vWorksheetObj.Range(TheData).Value = "The Profile found"
TheData = "AV" + CStr(i)
vWorksheetObj.Range(TheData).Value = IntNumVars
TheData = "Aw" + CStr(i)
vWorksheetObj.Range(TheData).Value = Profile
TheData = "AX" + CStr(i)
vWorksheetObj.Range(TheData).Value = TheReply

Profile = ""
TheReply = ""
IntNumVars = 0
End If ' the data = total

' If we get here and the profile has not been found then blank the
profile
If IntTheRow = 0 Then PrevProfile = Profile: Profile = ""


Ignore:
' GoTo CleanUp
x = x + 1
Next ' For i = 3 To IntNumOfRows




' This cleanup part of the program should run every time
CleanUp:
' Start with the profiles file first
If Not pWorksheetObj Is Nothing Then
Set pWorksheetObj = Nothing
End If
If Not pWorkbookObj Is Nothing Then
Set pWorkbookObj = Nothing
End If
' pXlsApplication.Quit
' Set pXlsApplication = Nothing

' this is the VMi File
' we need to save the file here
If Not vWorksheetObj Is Nothing Then
Set vWorksheetObj = Nothing
End If
If Not vWorkbookObj Is Nothing Then
Set vWorkbookObj = Nothing
End If
vXlsApplication.Quit
Set vXlsApplication = Nothing
End With ' vXlsApplication
Exit Sub

' This is only run if an error occurs
localErr:
If Err.Number <> 0 Then
Message = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Message, , "Error", Err.HelpFile, Err.HelpContext

End If

GoTo CleanUp

End Sub

[Tom Ogilvy]

With pWorksheetObj
If Profile <> "" And Left(Profile, 5) <> "brand" And TheReply =
"" Then
' GoTo CleanUp
IntNumProfile = WorksheetFunction.CountIf(,.Columns("m:m"),
Profile)
IntNumProfile = WorksheetFunction.CountIf(.Columns(12), "Phils
thing")

Put a period in front of columns so they are qualified by the pWorksheetObj
in your with statement.

--
Regards,
Tom Ogilvy


"Pingle Phil" <[email protected]> wrote in message
news:[email protected]...
>
> Bob Phillips wrote:
> > Try this
> >
> > If ActiveSheet.Evaluate("SumProduct(--(sheet1!A1:A15=sheet2!A5)," & _
> > "--(sheet1!C1:C15<>""""))") = 0 Then
> > cond_average = -1
> > Else
> > cond_average = Application.SumIf(a, b, c) / Application.CountIf(a,
b)
> > End If
> >
> >
> > --
> > HTH
> >
> > Bob Phillips
> >
> > (remove nothere from email address if mailing direct)
> >
> > "Gil D." <[email protected]> wrote in message
> > news:[email protected]...
> > > Hello,
> > >
> > > I wrote a function which is using SumProduct.
> > >
> > > a is a worksheet range
> > > b is a worksheet cell
> > > c is a worksheet range
> > >
> > > Function cond_average(a, b, c)
> > >
> > > If Application.SumProduct(--(a = b), --(c <> "")) = 0 Then
> > > cond_average = -1
> > > Else
> > > cond_average = Application.SumIf(a, b, c) / Application.CountIf(a,
> > > b)
> > > End If
> > >
> > > End Function
> > >
> > > Sumif and CountIf functions works but SumProduct returns error.
> > >
> > > What is wrong ?
> > >
> > > thank you
> > > Gil D.
> > >
>
> I have a similar problem to this but I cannot get the countif function
> to look at the correct worksheet. Any chance of some help on this?
>
> I have a blank workbook with the macro being run after choosing 2 file
> names.
> File 1 = a list of item that require additional data adding to the
> columns
> File 2 = is the additional data that is required.
>
> The unique identifier is a combination of the items dimensions and what
> its used for
> I can fid the item Ok with the find statement but if the item does not
> exist it throws an error. That is why I am trying the Countif to see if
> the item exists.
> The countif always looks at the workbook that the macro is in.
> As I have only been doing VBA code a 2 weeks I have included all the
> code.
>
> Private Sub ImportEstimate(ByVal strFilename As String, strProfiles As
> String)
>
> Dim vXlsApplication As Excel.Application
> Dim vWorkbookObj As Workbook
> Dim vWorksheetObj As Excel.Worksheet
> ' Dim pXlsApplication As Excel.Application
> Dim pWorkbookObj As Workbook
> Dim pWorksheetObj As Excel.Worksheet
> Dim IntSheetNum As Integer
> Dim IntSheet As Integer
> Dim IntNumOfRows As Integer
> Dim IntTheRow As Integer
> Dim IntNumVars As Integer
> Dim IntNumProfile As Integer
> Dim x As Integer
> Dim i As Integer
> Dim BottomCel As String
> Dim SourceRange
> Dim WorkSheetName As String
> Dim Message As String
> Dim TheText As String
> Dim TheReply As String
> Dim TheData As String
> Dim Profile As String
> Dim PrevProfile As String
>
>
> On Error GoTo localErr
> With vXlsApplication
> 'Open the VMI File
> Set vXlsApplication = New Excel.Application
>
>
> ' Open the profiles spreadsheet
> ' Set pXlsApplication = New Excel.Application
> ' See if the file is already open
> If Not WorkbookOpen(strProfiles) Then
> Set pWorkbookObj = vXlsApplication.Workbooks.Open(strProfiles)
> Set pWorksheetObj = pWorkbookObj.Worksheets(1)
> pWorksheetObj.Activate
> vXlsApplication.Visible = True
> End If
>
> 'Open the data File
> ' See if the file is already open
> If Not WorkbookOpen(strFilename) Then
> Set vWorkbookObj = vXlsApplication.Workbooks.Open(strFilename)
> ' vXlsApplication.Visible = True
>
> End If
>
> IntSheetNum = vWorkbookObj.Worksheets.Count
> For IntSheet = 1 To IntSheetNum
> Set vWorksheetObj = vWorkbookObj.Worksheets(IntSheet)
> vWorksheetObj.Activate
> WorkSheetName = vWorksheetObj.Name
>
> If LCase(WorkSheetName) = "backs" Then GoTo foundSheet
>
> Next ' IntSheet
>
> GoTo localErr ' We will only get here if the worksheet is not found
>
> foundSheet:
>
>
> IntNumOfRows = vWorksheetObj.UsedRange.Rows.Count
> BottomCel = "A" + CStr(IntNumOfRows)
> If IntNumOfRows < 2 Then End ' test if source range is empty
> Set SourceRange = vWorksheetObj.Range("A2", BottomCel)
>
> TheReply = ""
> x = 1
> 'Start at 4 as we cant be bothered to do the headings
> For i = 3 To IntNumOfRows
>
> If Profile = "" Then
> TheData = "AP" + CStr(i) + ":AP" + CStr(i)
> Profile = Trim(LCase(vWorksheetObj.Range(TheData)))
> TheData = "Aq" + CStr(i) + ":Aq" + CStr(i)
> Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
> TheData = "Ar" + CStr(i) + ":Ar" + CStr(i)
> Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
> TheData = "As" + CStr(i) + ":As" + CStr(i)
> Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
> TheData = "AT" + CStr(i) + ":AT" + CStr(i)
> Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
> End If
> If Profile <> "" Then IntNumVars = IntNumVars + 1
>
> If i = 4 Then MsgBox Profile + " w " + TheReply ' For debuging
>
> ' On Error GoTo Ignore
> With pWorksheetObj
> If Profile <> "" And Left(Profile, 5) <> "brand" And TheReply =
> "" Then
> ' GoTo CleanUp
> IntNumProfile = WorksheetFunction.CountIf(Columns("m:m"),
> Profile)
> IntNumProfile = WorksheetFunction.CountIf(Columns(12), "Phils
> thing")
> IntTheRow = 0
> If Profile <> "" And IntNumProfile <> 0 Then
>
> IntTheRow = pWorksheetObj.Columns("H").Find(Profile,
> LookIn:=xlValues, lookat:=xlWhole).Row
> End If 'count if
> If IntTheRow <> 0 Then
> TheData = "H" + CStr(IntTheRow)
> TheReply = pWorksheetObj.Range(TheData).Value
> MsgBox Profile + " " + TheReply
> End If ' If IntTheRow <> 0
> End If ' The profile
> End With ' pWorkSheetObj
> If Profile = "" Then Profile = PrevProfile
>
> If i = 4 Then MsgBox Profile + " q " + TheReply
>
> ' Now see if its the end of the product group
> TheData = "B" + CStr(i)
> TheText = Trim(LCase(vWorksheetObj.Range(TheData)))
> If TheText = "total" Then
> If TheReply = "" Then
> ' MsgBox "No parameter details found " + Profile
> TheData = "AU" + CStr(i)
> vWorksheetObj.Range(TheData).Value = "No Profile found"
> TheData = "AV" + CStr(i)
> vWorksheetObj.Range(TheData).Value = IntNumVars
> TheData = "Aw" + CStr(i)
> vWorksheetObj.Range(TheData).Value = Profile
> IntNumVars = 0
> Profile = ""
> TheReply = ""
> GoTo Ignore
> End If ' thereply = ""
> TheData = "AU" + CStr(i)
> vWorksheetObj.Range(TheData).Value = "The Profile found"
> TheData = "AV" + CStr(i)
> vWorksheetObj.Range(TheData).Value = IntNumVars
> TheData = "Aw" + CStr(i)
> vWorksheetObj.Range(TheData).Value = Profile
> TheData = "AX" + CStr(i)
> vWorksheetObj.Range(TheData).Value = TheReply
>
> Profile = ""
> TheReply = ""
> IntNumVars = 0
> End If ' the data = total
>
> ' If we get here and the profile has not been found then blank the
> profile
> If IntTheRow = 0 Then PrevProfile = Profile: Profile = ""
>
>
> Ignore:
> ' GoTo CleanUp
> x = x + 1
> Next ' For i = 3 To IntNumOfRows
>
>
>
>
> ' This cleanup part of the program should run every time
> CleanUp:
> ' Start with the profiles file first
> If Not pWorksheetObj Is Nothing Then
> Set pWorksheetObj = Nothing
> End If
> If Not pWorkbookObj Is Nothing Then
> Set pWorkbookObj = Nothing
> End If
> ' pXlsApplication.Quit
> ' Set pXlsApplication = Nothing
>
> ' this is the VMi File
> ' we need to save the file here
> If Not vWorksheetObj Is Nothing Then
> Set vWorksheetObj = Nothing
> End If
> If Not vWorkbookObj Is Nothing Then
> Set vWorkbookObj = Nothing
> End If
> vXlsApplication.Quit
> Set vXlsApplication = Nothing
> End With ' vXlsApplication
> Exit Sub
>
> ' This is only run if an error occurs
> localErr:
> If Err.Number <> 0 Then
> Message = "Error # " & Str(Err.Number) & " was generated by " _
> & Err.Source & Chr(13) & Err.Description
> MsgBox Message, , "Error", Err.HelpFile, Err.HelpContext
>
> End If
>
> GoTo CleanUp
>
> End Sub
>

[Pingle Phil]

Tom Ogilvy wrote:
> With pWorksheetObj
> If Profile <> "" And Left(Profile, 5) <> "brand" And TheReply =
> "" Then
> ' GoTo CleanUp
> IntNumProfile = WorksheetFunction.CountIf(,.Columns("m:m"),
> Profile)
> IntNumProfile = WorksheetFunction.CountIf(.Columns(12), "Phils
> thing")
>
> Put a period in front of columns so they are qualified by the pWorksheetObj
> in your with statement.
>
> --
> Regards,
> Tom Ogilvy
>
>
> "Pingle Phil" <[email protected]> wrote in message
> news:[email protected]...
> >
> > Bob Phillips wrote:
> > > Try this
> > >
> > > If ActiveSheet.Evaluate("SumProduct(--(sheet1!A1:A15=sheet2!A5)," & _
> > > "--(sheet1!C1:C15<>""""))") = 0 Then
> > > cond_average = -1
> > > Else
> > > cond_average = Application.SumIf(a, b, c) / Application.CountIf(a,
> b)
> > > End If
> > >
> > >
> > > --
> > > HTH
> > >
> > > Bob Phillips
> > >
> > > (remove nothere from email address if mailing direct)
> > >
> > > "Gil D." <[email protected]> wrote in message
> > > news:[email protected]...
> > > > Hello,
> > > >
> > > > I wrote a function which is using SumProduct.
> > > >
> > > > a is a worksheet range
> > > > b is a worksheet cell
> > > > c is a worksheet range
> > > >
> > > > Function cond_average(a, b, c)
> > > >
> > > > If Application.SumProduct(--(a = b), --(c <> "")) = 0 Then
> > > > cond_average = -1
> > > > Else
> > > > cond_average = Application.SumIf(a, b, c) / Application.CountIf(a,
> > > > b)
> > > > End If
> > > >
> > > > End Function
> > > >
> > > > Sumif and CountIf functions works but SumProduct returns error.
> > > >
> > > > What is wrong ?
> > > >
> > > > thank you
> > > > Gil D.
> > > >
> >
> > I have a similar problem to this but I cannot get the countif function
> > to look at the correct worksheet. Any chance of some help on this?
> >
> > I have a blank workbook with the macro being run after choosing 2 file
> > names.
> > File 1 = a list of item that require additional data adding to the
> > columns
> > File 2 = is the additional data that is required.
> >
> > The unique identifier is a combination of the items dimensions and what
> > its used for
> > I can fid the item Ok with the find statement but if the item does not
> > exist it throws an error. That is why I am trying the Countif to see if
> > the item exists.
> > The countif always looks at the workbook that the macro is in.
> > As I have only been doing VBA code a 2 weeks I have included all the
> > code.
> >
> > Private Sub ImportEstimate(ByVal strFilename As String, strProfiles As
> > String)
> >
> > Dim vXlsApplication As Excel.Application
> > Dim vWorkbookObj As Workbook
> > Dim vWorksheetObj As Excel.Worksheet
> > ' Dim pXlsApplication As Excel.Application
> > Dim pWorkbookObj As Workbook
> > Dim pWorksheetObj As Excel.Worksheet
> > Dim IntSheetNum As Integer
> > Dim IntSheet As Integer
> > Dim IntNumOfRows As Integer
> > Dim IntTheRow As Integer
> > Dim IntNumVars As Integer
> > Dim IntNumProfile As Integer
> > Dim x As Integer
> > Dim i As Integer
> > Dim BottomCel As String
> > Dim SourceRange
> > Dim WorkSheetName As String
> > Dim Message As String
> > Dim TheText As String
> > Dim TheReply As String
> > Dim TheData As String
> > Dim Profile As String
> > Dim PrevProfile As String
> >
> >
> > On Error GoTo localErr
> > With vXlsApplication
> > 'Open the VMI File
> > Set vXlsApplication = New Excel.Application
> >
> >
> > ' Open the profiles spreadsheet
> > ' Set pXlsApplication = New Excel.Application
> > ' See if the file is already open
> > If Not WorkbookOpen(strProfiles) Then
> > Set pWorkbookObj = vXlsApplication.Workbooks.Open(strProfiles)
> > Set pWorksheetObj = pWorkbookObj.Worksheets(1)
> > pWorksheetObj.Activate
> > vXlsApplication.Visible = True
> > End If
> >
> > 'Open the data File
> > ' See if the file is already open
> > If Not WorkbookOpen(strFilename) Then
> > Set vWorkbookObj = vXlsApplication.Workbooks.Open(strFilename)
> > ' vXlsApplication.Visible = True
> >
> > End If
> >
> > IntSheetNum = vWorkbookObj.Worksheets.Count
> > For IntSheet = 1 To IntSheetNum
> > Set vWorksheetObj = vWorkbookObj.Worksheets(IntSheet)
> > vWorksheetObj.Activate
> > WorkSheetName = vWorksheetObj.Name
> >
> > If LCase(WorkSheetName) = "backs" Then GoTo foundSheet
> >
> > Next ' IntSheet
> >
> > GoTo localErr ' We will only get here if the worksheet is not found
> >
> > foundSheet:
> >
> >
> > IntNumOfRows = vWorksheetObj.UsedRange.Rows.Count
> > BottomCel = "A" + CStr(IntNumOfRows)
> > If IntNumOfRows < 2 Then End ' test if source range is empty
> > Set SourceRange = vWorksheetObj.Range("A2", BottomCel)
> >
> > TheReply = ""
> > x = 1
> > 'Start at 4 as we cant be bothered to do the headings
> > For i = 3 To IntNumOfRows
> >
> > If Profile = "" Then
> > TheData = "AP" + CStr(i) + ":AP" + CStr(i)
> > Profile = Trim(LCase(vWorksheetObj.Range(TheData)))
> > TheData = "Aq" + CStr(i) + ":Aq" + CStr(i)
> > Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
> > TheData = "Ar" + CStr(i) + ":Ar" + CStr(i)
> > Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
> > TheData = "As" + CStr(i) + ":As" + CStr(i)
> > Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
> > TheData = "AT" + CStr(i) + ":AT" + CStr(i)
> > Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
> > End If
> > If Profile <> "" Then IntNumVars = IntNumVars + 1
> >
> > If i = 4 Then MsgBox Profile + " w " + TheReply ' For debuging
> >
> > ' On Error GoTo Ignore
> > With pWorksheetObj
> > If Profile <> "" And Left(Profile, 5) <> "brand" And TheReply =
> > "" Then
> > ' GoTo CleanUp
> > IntNumProfile = WorksheetFunction.CountIf(Columns("m:m"),
> > Profile)
> > IntNumProfile = WorksheetFunction.CountIf(Columns(12), "Phils
> > thing")
> > IntTheRow = 0
> > If Profile <> "" And IntNumProfile <> 0 Then
> >
> > IntTheRow = pWorksheetObj.Columns("H").Find(Profile,
> > LookIn:=xlValues, lookat:=xlWhole).Row
> > End If 'count if
> > If IntTheRow <> 0 Then
> > TheData = "H" + CStr(IntTheRow)
> > TheReply = pWorksheetObj.Range(TheData).Value
> > MsgBox Profile + " " + TheReply
> > End If ' If IntTheRow <> 0
> > End If ' The profile
> > End With ' pWorkSheetObj
> > If Profile = "" Then Profile = PrevProfile
> >
> > If i = 4 Then MsgBox Profile + " q " + TheReply
> >
> > ' Now see if its the end of the product group
> > TheData = "B" + CStr(i)
> > TheText = Trim(LCase(vWorksheetObj.Range(TheData)))
> > If TheText = "total" Then
> > If TheReply = "" Then
> > ' MsgBox "No parameter details found " + Profile
> > TheData = "AU" + CStr(i)
> > vWorksheetObj.Range(TheData).Value = "No Profile found"
> > TheData = "AV" + CStr(i)
> > vWorksheetObj.Range(TheData).Value = IntNumVars
> > TheData = "Aw" + CStr(i)
> > vWorksheetObj.Range(TheData).Value = Profile
> > IntNumVars = 0
> > Profile = ""
> > TheReply = ""
> > GoTo Ignore
> > End If ' thereply = ""
> > TheData = "AU" + CStr(i)
> > vWorksheetObj.Range(TheData).Value = "The Profile found"
> > TheData = "AV" + CStr(i)
> > vWorksheetObj.Range(TheData).Value = IntNumVars
> > TheData = "Aw" + CStr(i)
> > vWorksheetObj.Range(TheData).Value = Profile
> > TheData = "AX" + CStr(i)
> > vWorksheetObj.Range(TheData).Value = TheReply
> >
> > Profile = ""
> > TheReply = ""
> > IntNumVars = 0
> > End If ' the data = total
> >
> > ' If we get here and the profile has not been found then blank the
> > profile
> > If IntTheRow = 0 Then PrevProfile = Profile: Profile = ""
> >
> >
> > Ignore:
> > ' GoTo CleanUp
> > x = x + 1
> > Next ' For i = 3 To IntNumOfRows
> >
> >
> >
> >
> > ' This cleanup part of the program should run every time
> > CleanUp:
> > ' Start with the profiles file first
> > If Not pWorksheetObj Is Nothing Then
> > Set pWorksheetObj = Nothing
> > End If
> > If Not pWorkbookObj Is Nothing Then
> > Set pWorkbookObj = Nothing
> > End If
> > ' pXlsApplication.Quit
> > ' Set pXlsApplication = Nothing
> >
> > ' this is the VMi File
> > ' we need to save the file here
> > If Not vWorksheetObj Is Nothing Then
> > Set vWorksheetObj = Nothing
> > End If
> > If Not vWorkbookObj Is Nothing Then
> > Set vWorkbookObj = Nothing
> > End If
> > vXlsApplication.Quit
> > Set vXlsApplication = Nothing
> > End With ' vXlsApplication
> > Exit Sub
> >
> > ' This is only run if an error occurs
> > localErr:
> > If Err.Number <> 0 Then
> > Message = "Error # " & Str(Err.Number) & " was generated by " _
> > & Err.Source & Chr(13) & Err.Description
> > MsgBox Message, , "Error", Err.HelpFile, Err.HelpContext
> >
> > End If
> >
> > GoTo CleanUp
> >
> > End Sub
> >


Thanks for the post but I now get
Error # 1004 was generated by Microsoft Excel
Unable to get the CountIf property of the WorkSheetFunction Class
I tried to fully qualify the name by putting
IntNumProfile = WorksheetFunction.CountIf(pWorksheetObj.Columns("m:m"),
Profile) and this produces the same error

[Tom Ogilvy]

demo'd from the immediate window:

profile = "A"
set pWorksheetObj = Activesheet
? WorksheetFunction.CountIf(pWorksheetObj.Columns("m:m"), Profile)
1

so I have no problem with it it everything is set properly.

--
Regards,
Tom Ogilvy


"Pingle Phil" <[email protected]> wrote in message
news:[email protected]...
>
> Tom Ogilvy wrote:
> > With pWorksheetObj
> > If Profile <> "" And Left(Profile, 5) <> "brand" And TheReply =
> > "" Then
> > ' GoTo CleanUp
> > IntNumProfile = WorksheetFunction.CountIf(,.Columns("m:m"),
> > Profile)
> > IntNumProfile = WorksheetFunction.CountIf(.Columns(12), "Phils
> > thing")
> >
> > Put a period in front of columns so they are qualified by the
pWorksheetObj
> > in your with statement.
> >
> > --
> > Regards,
> > Tom Ogilvy
> >
> >
> > "Pingle Phil" <[email protected]> wrote in message
> > news:[email protected]...
> > >
> > > Bob Phillips wrote:
> > > > Try this
> > > >
> > > > If ActiveSheet.Evaluate("SumProduct(--(sheet1!A1:A15=sheet2!A5)," &
_
> > > > "--(sheet1!C1:C15<>""""))") = 0 Then
> > > > cond_average = -1
> > > > Else
> > > > cond_average = Application.SumIf(a, b, c) /
Application.CountIf(a,
> > b)
> > > > End If
> > > >
> > > >
> > > > --
> > > > HTH
> > > >
> > > > Bob Phillips
> > > >
> > > > (remove nothere from email address if mailing direct)
> > > >
> > > > "Gil D." <[email protected]> wrote in message
> > > > news:[email protected]...
> > > > > Hello,
> > > > >
> > > > > I wrote a function which is using SumProduct.
> > > > >
> > > > > a is a worksheet range
> > > > > b is a worksheet cell
> > > > > c is a worksheet range
> > > > >
> > > > > Function cond_average(a, b, c)
> > > > >
> > > > > If Application.SumProduct(--(a = b), --(c <> "")) = 0 Then
> > > > > cond_average = -1
> > > > > Else
> > > > > cond_average = Application.SumIf(a, b, c) /
Application.CountIf(a,
> > > > > b)
> > > > > End If
> > > > >
> > > > > End Function
> > > > >
> > > > > Sumif and CountIf functions works but SumProduct returns error.
> > > > >
> > > > > What is wrong ?
> > > > >
> > > > > thank you
> > > > > Gil D.
> > > > >
> > >
> > > I have a similar problem to this but I cannot get the countif
function
> > > to look at the correct worksheet. Any chance of some help on this?
> > >
> > > I have a blank workbook with the macro being run after choosing 2 file
> > > names.
> > > File 1 = a list of item that require additional data adding to the
> > > columns
> > > File 2 = is the additional data that is required.
> > >
> > > The unique identifier is a combination of the items dimensions and
what
> > > its used for
> > > I can fid the item Ok with the find statement but if the item does
not
> > > exist it throws an error. That is why I am trying the Countif to see
if
> > > the item exists.
> > > The countif always looks at the workbook that the macro is in.
> > > As I have only been doing VBA code a 2 weeks I have included all the
> > > code.
> > >
> > > Private Sub ImportEstimate(ByVal strFilename As String, strProfiles As
> > > String)
> > >
> > > Dim vXlsApplication As Excel.Application
> > > Dim vWorkbookObj As Workbook
> > > Dim vWorksheetObj As Excel.Worksheet
> > > ' Dim pXlsApplication As Excel.Application
> > > Dim pWorkbookObj As Workbook
> > > Dim pWorksheetObj As Excel.Worksheet
> > > Dim IntSheetNum As Integer
> > > Dim IntSheet As Integer
> > > Dim IntNumOfRows As Integer
> > > Dim IntTheRow As Integer
> > > Dim IntNumVars As Integer
> > > Dim IntNumProfile As Integer
> > > Dim x As Integer
> > > Dim i As Integer
> > > Dim BottomCel As String
> > > Dim SourceRange
> > > Dim WorkSheetName As String
> > > Dim Message As String
> > > Dim TheText As String
> > > Dim TheReply As String
> > > Dim TheData As String
> > > Dim Profile As String
> > > Dim PrevProfile As String
> > >
> > >
> > > On Error GoTo localErr
> > > With vXlsApplication
> > > 'Open the VMI File
> > > Set vXlsApplication = New Excel.Application
> > >
> > >
> > > ' Open the profiles spreadsheet
> > > ' Set pXlsApplication = New Excel.Application
> > > ' See if the file is already open
> > > If Not WorkbookOpen(strProfiles) Then
> > > Set pWorkbookObj = vXlsApplication.Workbooks.Open(strProfiles)
> > > Set pWorksheetObj = pWorkbookObj.Worksheets(1)
> > > pWorksheetObj.Activate
> > > vXlsApplication.Visible = True
> > > End If
> > >
> > > 'Open the data File
> > > ' See if the file is already open
> > > If Not WorkbookOpen(strFilename) Then
> > > Set vWorkbookObj = vXlsApplication.Workbooks.Open(strFilename)
> > > ' vXlsApplication.Visible = True
> > >
> > > End If
> > >
> > > IntSheetNum = vWorkbookObj.Worksheets.Count
> > > For IntSheet = 1 To IntSheetNum
> > > Set vWorksheetObj = vWorkbookObj.Worksheets(IntSheet)
> > > vWorksheetObj.Activate
> > > WorkSheetName = vWorksheetObj.Name
> > >
> > > If LCase(WorkSheetName) = "backs" Then GoTo foundSheet
> > >
> > > Next ' IntSheet
> > >
> > > GoTo localErr ' We will only get here if the worksheet is not
found
> > >
> > > foundSheet:
> > >
> > >
> > > IntNumOfRows = vWorksheetObj.UsedRange.Rows.Count
> > > BottomCel = "A" + CStr(IntNumOfRows)
> > > If IntNumOfRows < 2 Then End ' test if source range is empty
> > > Set SourceRange = vWorksheetObj.Range("A2", BottomCel)
> > >
> > > TheReply = ""
> > > x = 1
> > > 'Start at 4 as we cant be bothered to do the headings
> > > For i = 3 To IntNumOfRows
> > >
> > > If Profile = "" Then
> > > TheData = "AP" + CStr(i) + ":AP" + CStr(i)
> > > Profile = Trim(LCase(vWorksheetObj.Range(TheData)))
> > > TheData = "Aq" + CStr(i) + ":Aq" + CStr(i)
> > > Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
> > > TheData = "Ar" + CStr(i) + ":Ar" + CStr(i)
> > > Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
> > > TheData = "As" + CStr(i) + ":As" + CStr(i)
> > > Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
> > > TheData = "AT" + CStr(i) + ":AT" + CStr(i)
> > > Profile = Profile + Trim(LCase(vWorksheetObj.Range(TheData)))
> > > End If
> > > If Profile <> "" Then IntNumVars = IntNumVars + 1
> > >
> > > If i = 4 Then MsgBox Profile + " w " + TheReply ' For debuging
> > >
> > > ' On Error GoTo Ignore
> > > With pWorksheetObj
> > > If Profile <> "" And Left(Profile, 5) <> "brand" And TheReply =
> > > "" Then
> > > ' GoTo CleanUp
> > > IntNumProfile = WorksheetFunction.CountIf(Columns("m:m"),
> > > Profile)
> > > IntNumProfile = WorksheetFunction.CountIf(Columns(12), "Phils
> > > thing")
> > > IntTheRow = 0
> > > If Profile <> "" And IntNumProfile <> 0 Then
> > >
> > > IntTheRow = pWorksheetObj.Columns("H").Find(Profile,
> > > LookIn:=xlValues, lookat:=xlWhole).Row
> > > End If 'count if
> > > If IntTheRow <> 0 Then
> > > TheData = "H" + CStr(IntTheRow)
> > > TheReply = pWorksheetObj.Range(TheData).Value
> > > MsgBox Profile + " " + TheReply
> > > End If ' If IntTheRow <> 0
> > > End If ' The profile
> > > End With ' pWorkSheetObj
> > > If Profile = "" Then Profile = PrevProfile
> > >
> > > If i = 4 Then MsgBox Profile + " q " + TheReply
> > >
> > > ' Now see if its the end of the product group
> > > TheData = "B" + CStr(i)
> > > TheText = Trim(LCase(vWorksheetObj.Range(TheData)))
> > > If TheText = "total" Then
> > > If TheReply = "" Then
> > > ' MsgBox "No parameter details found " + Profile
> > > TheData = "AU" + CStr(i)
> > > vWorksheetObj.Range(TheData).Value = "No Profile found"
> > > TheData = "AV" + CStr(i)
> > > vWorksheetObj.Range(TheData).Value = IntNumVars
> > > TheData = "Aw" + CStr(i)
> > > vWorksheetObj.Range(TheData).Value = Profile
> > > IntNumVars = 0
> > > Profile = ""
> > > TheReply = ""
> > > GoTo Ignore
> > > End If ' thereply = ""
> > > TheData = "AU" + CStr(i)
> > > vWorksheetObj.Range(TheData).Value = "The Profile found"
> > > TheData = "AV" + CStr(i)
> > > vWorksheetObj.Range(TheData).Value = IntNumVars
> > > TheData = "Aw" + CStr(i)
> > > vWorksheetObj.Range(TheData).Value = Profile
> > > TheData = "AX" + CStr(i)
> > > vWorksheetObj.Range(TheData).Value = TheReply
> > >
> > > Profile = ""
> > > TheReply = ""
> > > IntNumVars = 0
> > > End If ' the data = total
> > >
> > > ' If we get here and the profile has not been found then blank the
> > > profile
> > > If IntTheRow = 0 Then PrevProfile = Profile: Profile = ""
> > >
> > >
> > > Ignore:
> > > ' GoTo CleanUp
> > > x = x + 1
> > > Next ' For i = 3 To IntNumOfRows
> > >
> > >
> > >
> > >
> > > ' This cleanup part of the program should run every time
> > > CleanUp:
> > > ' Start with the profiles file first
> > > If Not pWorksheetObj Is Nothing Then
> > > Set pWorksheetObj = Nothing
> > > End If
> > > If Not pWorkbookObj Is Nothing Then
> > > Set pWorkbookObj = Nothing
> > > End If
> > > ' pXlsApplication.Quit
> > > ' Set pXlsApplication = Nothing
> > >
> > > ' this is the VMi File
> > > ' we need to save the file here
> > > If Not vWorksheetObj Is Nothing Then
> > > Set vWorksheetObj = Nothing
> > > End If
> > > If Not vWorkbookObj Is Nothing Then
> > > Set vWorkbookObj = Nothing
> > > End If
> > > vXlsApplication.Quit
> > > Set vXlsApplication = Nothing
> > > End With ' vXlsApplication
> > > Exit Sub
> > >
> > > ' This is only run if an error occurs
> > > localErr:
> > > If Err.Number <> 0 Then
> > > Message = "Error # " & Str(Err.Number) & " was generated by " _
> > > & Err.Source & Chr(13) & Err.Description
> > > MsgBox Message, , "Error", Err.HelpFile, Err.HelpContext
> > >
> > > End If
> > >
> > > GoTo CleanUp
> > >
> > > End Sub
> > >
>
>
> Thanks for the post but I now get
> Error # 1004 was generated by Microsoft Excel
> Unable to get the CountIf property of the WorkSheetFunction Class
> I tried to fully qualify the name by putting
> IntNumProfile = WorksheetFunction.CountIf(pWorksheetObj.Columns("m:m"),
> Profile) and this produces the same error
>

[Pingle Phil]

The worksheetfunction only could work in the instance where the macro
was and the data was in another instance. Thanks for you help

[Gil D.]

Hello,

Thank you for your help.

It works but I have new questions.

Gil D.

[Tom Ogilvy]

Separate instances of Excel are like completely separate applications. You
would have to automate one from the other. Although there may be a reason
to do that, generally it is better to open all workbooks in the same
instance if you want to work between them.

--
Regards,
Tom Ogilvy


"Pingle Phil" <[email protected]> wrote in message
news:[email protected]...
> The worksheetfunction only could work in the instance where the macro
> was and the data was in another instance. Thanks for you help
>