Bob said:
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)
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
