Anyone knows whats wrong with the below codes??

Sub Compare2()
Dim wb As Workbook
Dim wsResult As Worksheet
Dim wsLut As Worksheet
Dim rngCrit1 As Range
Dim rngCrit2 As Range
Dim rngSelected As Integer
Dim rngToCount As Range
Dim rngCritNew As Range
Application.DisplayAlerts = False

On Error Resume Next

Set wb = ActiveWorkbook
If rngCrit1 < "" And rngCrit2 < "" Then
Set rngCrit1 = Application.InputBox("Select data range: "
Type:=8)
Set rngCrit2 = Application.InputBox("Select criteria range: "
Type:=8)
wb.Sheets("Results").Delete
wb.Sheets.Add After:=Sheets("Data")
ActiveSheet.Name = "Results"
Set wsLut = ActiveWorkbook.Sheets("LUT")
Set wsResult = ActiveWorkbook.Sheets("Results")
rngCrit1.Copy Destination:=wsResult.Range("A2")
rngCrit2.Copy Destination:=wsResult.Range("C2")
wsResult.Range("A1") = "Data"
wsResult.Range("A1").Font.Bold = True
wsResult.Range("C1") = "Criterias"
wsResult.Range("C1").Font.Bold = True
wsResult.Range("D1") = "Result of Count"
wsResult.Range("D1").Font.Bold = True
Else
MsgBox "Please select the criteria"
End If

rngSelected = rngCrit1.Count
If rngSelected < 0 Then
With wsResult
Set rngCritNew = .Range("C2", .Range("C2").End(xlDown))
For Each c In rngCritNew
Crit = c.value
critCnt
Application.WorksheetFunction.SumProduct(Len(rngCr it1)
Len(Application.WorksheetFunction.Substitute(rngCr it1, "Crit", "")))
Len("Crit")
c.Offset(0, 1).value = critCnt
Next

ttlmatched
Application.WorksheetFunction.Sum(rngCritNew.Offse t(0, 1))
.Range("C2").End(xlDown).Offset(1, 0) = "No. Matched"
.Range("C2").End(xlDown).Offset(0, 1) = ttlmatched
.Range("C2").End(xlDown).Offset(1, 0).value = "No. NO
matched"
.Range("C2").End(xlDown).Offset(0, 1).value = rngSelected
ttlmatched
End With
MsgBox "Count completed"
End If
Application.DisplayAlerts = True
Exit Sub
End Sub


i believe tat my problem lies he

For Each c In rngCritNew
Crit = c.value
critCnt
Application.WorksheetFunction.SumProduct(Len(rngCr it1)
Len(Application.WorksheetFunction.Substitute(rngCr it1, "Crit", "")))
Len("Crit")
c.Offset(0, 1).value = critCnt
Next

as the codes run smoothly but doesn;t display the result. Anyone ca
help?

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

I'm slightly confused. What exactly is this code meant to
do? You appear to be trying to use string manipulation
functions (Len) on Range objects (rngCrit1) which will
cause a problem.

Len("Crit") will always be 4. I think you meant Len(Crit)

For Each c in rngCritNew.Cells
might also make a difference, I'm not sure.

Post back and let us know what you're trying to do here...

Pete

-----Original Message-----
Anyone knows whats wrong with the below codes??

Sub Compare2()
Dim wb As Workbook
Dim wsResult As Worksheet
Dim wsLut As Worksheet
Dim rngCrit1 As Range
Dim rngCrit2 As Range
Dim rngSelected As Integer
Dim rngToCount As Range
Dim rngCritNew As Range
Application.DisplayAlerts = False

On Error Resume Next

Set wb = ActiveWorkbook
If rngCrit1 < "" And rngCrit2 < "" Then
Set rngCrit1 = Application.InputBox("Select data range: ",
Type:=8)
Set rngCrit2 = Application.InputBox("Select criteria
range: ",
Type:=8)
wb.Sheets("Results").Delete
wb.Sheets.Add After:=Sheets("Data")
ActiveSheet.Name = "Results"
Set wsLut = ActiveWorkbook.Sheets("LUT")
Set wsResult = ActiveWorkbook.Sheets("Results")
rngCrit1.Copy Destination:=wsResult.Range("A2")
rngCrit2.Copy Destination:=wsResult.Range("C2")
wsResult.Range("A1") = "Data"
wsResult.Range("A1").Font.Bold = True
wsResult.Range("C1") = "Criterias"
wsResult.Range("C1").Font.Bold = True
wsResult.Range("D1") = "Result of Count"
wsResult.Range("D1").Font.Bold = True
Else
MsgBox "Please select the criteria"
End If

rngSelected = rngCrit1.Count
If rngSelected < 0 Then
With wsResult
Set rngCritNew = .Range("C2", .Range("C2").End(xlDown))
For Each c In rngCritNew
Crit = c.value
critCnt =
Application.WorksheetFunction.SumProduct(Len(rngC rit1) -
Len(Application.WorksheetFunction.Substitute
(rngCrit1, "Crit", ""))) /
Len("Crit")
c.Offset(0, 1).value = critCnt
Next

ttlmatched =
Application.WorksheetFunction.Sum(rngCritNew.Offs et(0, 1))
.Range("C2").End(xlDown).Offset(1, 0) = "No. Matched"
.Range("C2").End(xlDown).Offset(0, 1) = ttlmatched
.Range("C2").End(xlDown).Offset(1, 0).value = "No. NOT
matched"
.Range("C2").End(xlDown).Offset(0, 1).value =
rngSelected -
ttlmatched
End With
MsgBox "Count completed"
End If
Application.DisplayAlerts = True
Exit Sub
End Sub


i believe tat my problem lies he

For Each c In rngCritNew
Crit = c.value
critCnt =
Application.WorksheetFunction.SumProduct(Len(rngC rit1) -
Len(Application.WorksheetFunction.Substitute
(rngCrit1, "Crit", ""))) /
Len("Crit")
c.Offset(0, 1).value = critCnt
Next

as the codes run smoothly but doesn;t display the
result. Anyone can
help??


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

.

hi pete:
if u were to enter this function into normal excel worksheet, it woul
work fine.
=SUMPRODUCT((LEN(rngCrit1)-LEN(SUBSTITUTE(rngCrit1,Crit,"")))/LEN(Crit))

in this case
rngCrit1 = a range of data cells (Eg. A2:A31)
Crit = Criteria cells (Eg. C2)

Eg.
A1
*Data*
TanOTanKTan
Lee
TanTan
Who
Joo
Lee

C1
*Criteria*
Tan
Lee

D1
*Result of count*
5
1


What i am trying to do here is to count the no. of occurance of eac
criteria in that particular range of data using vba coding.
And the codes i posted above has no errors except that it doesn'
display the result.
One thing i have to addon is that the codes:

Application.WorksheetFunction.SumProduct(Len(rngCr it1) -
Len(Application.WorksheetFunction.Substitute
(rngCrit1, "Crit", ""))) /
Len("Crit")

has no error but vba doesn;t recognize the function "Len"
Thus i am not able to display the result.
If anyone can modify my codes for me i would really appreciate thei
help!
Thanks in advanced!!

ps: i have attached a sample of what i want to achieve here, pls hel
me, been stuck for 2 weeks already :

Attachment filename: sample.xls
Download attachment: http://www.excelforum.com/attachment.php?postid=63049
--
Message posted from http://www.ExcelForum.com