ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   SumProduct problem (https://www.excelbanter.com/excel-programming/353111-sumproduct-problem.html)

Gil D.
SumProduct problem
 
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[_13_]
SumProduct problem
 

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

Gil D.
SumProduct problem
 
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.
SumProduct problem
 
Hello,

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

I am using excel XP.

What can be wrong ?

Thank you
Gil D.

Tom Ogilvy
SumProduct problem
 
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"
wrote in message
news:daddylonglegs.23597y_1139794201.5387@excelfor um-nospam.com...

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
SumProduct problem
 
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." wrote in message
ups.com...
Hello,

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

I am using excel XP.

What can be wrong ?

Thank you
Gil D.

Bob Phillips[_6_]
SumProduct problem
 
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." wrote in message
oups.com...
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
SumProduct problem
 

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." wrote in message
oups.com...
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 = ""


Igno
' 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
SumProduct problem
 
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" wrote in message
oups.com...

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." wrote in message
oups.com...
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 = ""


Igno
' 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
SumProduct problem
 

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" wrote in message
oups.com...

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." wrote in message
oups.com...
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 = ""


Igno
' 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
SumProduct problem
 
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" wrote in message
oups.com...

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" wrote in message
oups.com...

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." wrote in message
oups.com...
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 = ""


Igno
' 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
SumProduct problem
 
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.
SumProduct problem
 
Hello,

Thank you for your help.

It works but I have new questions.

Gil D.

Tom Ogilvy
SumProduct problem
 
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" wrote in message
oups.com...
The worksheetfunction only could work in the instance where the macro
was and the data was in another instance. Thanks for you help


All times are GMT +1. The time now is 10:07 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com