Solved

# Count number of data

Posted on 2011-03-03
256 Views
Hi Experts,

I would like to request Experts help to add additional function in the attached script. The attached script able to crosscheck data at Validation sheet (column “Type”) with data at “Type” at “Total” sheet and updates number of data that were duped at Column “Count” (Total sheet).  I need help to crosscheck Data at Column “Type” (Total sheet) with data at “Data” Sheet (Table 1 to 6) and update the number of duped (frequency) of the data at “Total Data” column at “Total Sheet”. Hope Experts will help me to add this function. I have attached the workbook for Experts perusal.

``````Sub x()

Dim oDic As Object, vOut(), vIn(), i As Long, j As Long, n As Long, p As Long, nCol As Long

nCol = Application.InputBox("How many sets of columns for the results (each set has three columns)?", Type:=1)

With Sheets("Validation")
On Error Resume Next
.Rows(2).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete shift:=xlToLeft
On Error GoTo 0
vIn = .Range("A1").CurrentRegion.Value
End With

ReDim vOut(1 To UBound(vIn, 1) * UBound(vIn, 2), 1 To 3)

Set oDic = CreateObject("Scripting.Dictionary")

With oDic
For i = 2 To UBound(vIn, 1)
For j = 1 To UBound(vIn, 2) - 1 Step 2
If Not .Exists(vIn(i, j)) Then
n = n + 1
vOut(n, 1) = vIn(i, j)
vOut(n, 2) = Left(vIn(i, j + 1), 5)
vOut(n, 3) = 1
Else
vOut(.Item(vIn(i, j)), 3) = vOut(.Item(vIn(i, j)), 3) + 1
End If
Next j
Next i
End With

p = WorksheetFunction.RoundUp(n / nCol, 0)

With Sheets("Total")
.UsedRange.Clear
With .Range("A1")
.Resize(, 3).Value = Array("Number", "Type", "Count")
.Offset(1).Resize(n, 3) = vOut
For j = 1 To nCol - 1
.Offset(, j * 4).Resize(, 3).Value = Array("Number", "Type", "Count")
.Offset(p + 1, (j - 1) * 4).Resize(n - (p * j), 3).Cut .Offset(1, j * 4)
Next j
End With
End With

End Sub
``````
SpeedData.xls
0
Question by:Cartillo
• 17
• 16

LVL 3

Expert Comment

ID: 35033576
Hello Cartillo,

Please try to use following function to achieve the result:

``````Function CountData(item As String, table As Range) As Integer
Dim nCount As Integer
Dim strTmp As String
Dim nI As Integer
Dim nJ As Integer
For nI = 1 To table.Columns.Count
For nJ = 1 To table.Columns(nI).Rows.Count
strTmp = table.Columns(nI).Rows(nJ).Value
If (strTmp <> "") And (Left(strTmp, 5) = item) Then
nCount = nCount + 1
End If
Next nJ
Next nI
CountData = nCount
End Function
``````

I also enclosed the file here for your reference.

I hope it helps.

Long
SpeedData.xls
0

Author Comment

ID: 35033603
Hi Long,

Thanks for the help. How we can integrate the the “Sub x()” module with your solution. Can run it simultaneously?
0

LVL 3

Expert Comment

ID: 35033652
Hello Cartillo,

Before the End Function statement in CountData function, you can use x() to call your sub.

Thing looks like as follows:

``````Function CountData...
....
x()
End Function
``````
Long
0

Author Comment

ID: 35033655
Hi Long,

Is that possible to call your solution after Sub X? I need to run Sub X first in order for me to get the right sequence. Hope you’ll help me.
0

LVL 3

Expert Comment

ID: 35033674
Hello Cartillo,

If so, you need to place x() right after CountData function.  Thing looks like as follows:

``````Function CountData(item As String, table As Range) As Integer
x()
Dim nCount As Integer
Dim strTmp As String
Dim nI As Integer
Dim nJ As Integer
For nI = 1 To table.Columns.Count
For nJ = 1 To table.Columns(nI).Rows.Count
strTmp = table.Columns(nI).Rows(nJ).Value
If (strTmp <> "") And (Left(strTmp, 5) = item) Then
nCount = nCount + 1
End If
Next nJ
Next nI
CountData = nCount
End Function
``````

I hope it helps.

Long
0

Author Comment

ID: 35033690
Hi Long,

But when type x() it shows in Red in color. How to fix this.
0

LVL 3

Expert Comment

ID: 35033738
Hello Cartillo,

It was my bad as I always think of C++ every time I write code :-).  Please only use x instead of x(). It is because VB treats sub and function differently.  So, the correct code should be:

``````Function CountData(item As String, table As Range) As Integer
x
Dim nCount As Integer
Dim strTmp As String
Dim nI As Integer
Dim nJ As Integer
For nI = 1 To table.Columns.Count
For nJ = 1 To table.Columns(nI).Rows.Count
strTmp = table.Columns(nI).Rows(nJ).Value
If (strTmp <> "") And (Left(strTmp, 5) = item) Then
nCount = nCount + 1
End If
Next nJ
Next nI
CountData = nCount
End Function
``````

Long
0

Author Comment

ID: 35033955
Hi,

I’ve tried to get the result by running the code by clicking the “Run” button at Total Sheet, but failed. Am I missing something? I have attached the workbook for your kind perusal.

SpeedData1.xls
0

LVL 3

Expert Comment

ID: 35034111
Hello Cartillo,

Well, now your request  is clearer.  I have incorporate the CountData function into your x().  The detailed code is as follows:

``````Sub x()

Dim oDic As Object, vOut(), vIn(), i As Long, j As Long, n As Long, p As Long, nCol As Long

nCol = Application.InputBox("How many sets of columns for the results (each set has three columns)?", Type:=1)

With Sheets("Validation")
On Error Resume Next
.Rows(2).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete shift:=xlToLeft
On Error GoTo 0
vIn = .Range("A1").CurrentRegion.Value
End With

ReDim vOut(1 To UBound(vIn, 1) * UBound(vIn, 2), 1 To 3)

Set oDic = CreateObject("Scripting.Dictionary")

With oDic
For i = 2 To UBound(vIn, 1)
For j = 1 To UBound(vIn, 2) - 1 Step 2
If Not .Exists(vIn(i, j)) Then
n = n + 1
vOut(n, 1) = vIn(i, j)
vOut(n, 2) = Left(vIn(i, j + 1), 5)
vOut(n, 3) = 1
Else
vOut(.item(vIn(i, j)), 3) = vOut(.item(vIn(i, j)), 3) + 1
End If
Next j
Next i
End With

p = WorksheetFunction.RoundUp(n / nCol, 0)

With Sheets("Total")
.UsedRange.Clear
With .Range("A1")
[b].Resize(, 4).Value = Array("Number", "Type", "Count", "Total Data") 'Long modified[/b]        .Offset(1).Resize(n, 3) = vOut
For j = 1 To nCol - 1
[b].Offset(, j * 4).Resize(, 4).Value = Array("Number", "Type", "Count", "Total Data") 'Long modified[/b]            .Offset(p + 1, (j - 1) * 4).Resize(n - (p * j), 3).Cut .Offset(1, j * 4)
Next j
End With
End With

Dim nC As Long, nR As Long, nCTmp As Long, nVal As Long, strCellVal As String

For nC = 1 To nCol
For nR = 1 To p
nCTmp = (nC - 1) * 4 + 2
strCellVal = Range(Chr(64 + nCTmp) & Trim(Str(nR + 1))).Value

If strCellVal <> "" Then
nVal = CountData(strCellVal, Range("TABLEDATA"))
nCTmp = nCTmp + 2
Range(Chr(64 + nCTmp) & Trim(Str(nR + 1))).Value = nVal
End If
Next nR
Next nC[/b]

End Sub
``````

I have also enclosed the updated file here for your reference.

Regards,

Long SpeedData1.xls
0

LVL 3

Expert Comment

ID: 35034125
Hello Cartillo again,

Please remove and from the code shown in my previous response because they have been added to the code mistakenly.  However, the attached file is still good and you can use it right away.

Regards,

Long
0

LVL 3

Expert Comment

ID: 35034130
Hello Cartillo again,

Please remove [ b ] and [ / b ] from the code shown in my previous response because they have been added to the code mistakenly.  However, the attached file is still good and you can use it right away.

Regards,

Long
0

Author Comment

ID: 35034139
Hi Long,

Thanks for the code. Have tested, but shows an error as "Method "Range" of object "Global" Failed" at this line:

Range(Chr(64 + nCTmp) & Trim(Str(nR + 1))).Value = nVal

How to fix this?
0

Author Comment

ID: 35034207
Hi Long,

I noticed the code failed to work if more than 6 sets of data being assigned (it works perfectly if less than 6 data set). Can we make it this flexible?
0

LVL 3

Expert Comment

ID: 35034214
Hi Cartillo,

Range("A1").Value = Chr(64 + nCTmp) & Trim(Str(nR + 1))
Exit Sub

Then, please run the code again.  After that, please copy the value of cell A1 and post it here.  Please remember to copy the exact value of A1 (including spaces) as it is very important for me to investigate.

Thanks,

Long
0

LVL 3

Expert Comment

ID: 35034241
Hello Cartillo,

strCellVal = Range(Chr(64 + nCTmp) & Trim(Str(nR + 1))).Value
to
strCellVal = Cells(nR + 1, nCTmp).Value

and change

Range(Chr(64 + nCTmp) & Trim(Str(nR + 1))).Value = nVal
to
Cells(nR + 1, nCTmp).Value = nVal

The code now should work properly.

Regards,

Long
0

Author Comment

ID: 35034312
Hi Long,

Thanks for the help. Is that possible to speed up the Total Data count process. The code able to crosscheck 70,000 data rows for “Number” ,” Type” and “Count” within 3 minute, but it takes more  than 40 minutes to crosscheck “Total Data”. Hope you will consider this request.
0

LVL 3

Expert Comment

ID: 35035460
Hello Cartillo,

I have removed CountData function and revised your x sub routine to overcome the slow performance issue.  Could you please re-try the attached file and let me know if it meets your expectation?

Thanks,

Long
SpeedData1.xls
0

Author Comment

ID: 35041244

Hi Long,

It's extremely fast. Thanks for the great help. I have one issue with unique data, especially on the Number type. The code only extracted unique number from Validation sheet and matched it with unique Type. Sometime I do have same Number but different "Type" data, e.g. for "573510" I have:

BAXHT
BANTA
BAZDD
BAZKS

But the code only copied "BAXHT" other data have been omitted.

How to make sure the same number with varies Type data are also copied without missed. Hope you will consider my request.
0

Author Comment

ID: 35041806
Hi Long,

When I crosschecked big data, its failed as "Object Defined Error" at this line:
.Offset(1).Resize(n, 3) = vOut

How to fix this? I have attached the sample data that I have used (in text file). Can't send it via excel, quite big.
Sdata.zip
0

Author Comment

ID: 35042026
Hi Long,

Manage to solve the "Object Defined Error" issue with the attached script, but not sure how to overcome same number with various Type data. Hope you will help me to make the code able to tackle this issue.
``````Sub x()

Dim oDic As Object, vOut(), vIn(), vOut2()
Dim i As Long, j As Long, k As Long, n As Long, p As Long, nCol As Long, r As Long

nCol = Application.InputBox("How many sets of columns for the results (each set has three columns)?", Type:=1)

With Sheets("Validation")
On Error Resume Next
.Rows(2).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete shift:=xlToLeft
On Error GoTo 0
vIn = .Range("A1").CurrentRegion.Value
End With

ReDim vOut(1 To UBound(vIn, 1) * UBound(vIn, 2), 1 To 3)

Set oDic = CreateObject("Scripting.Dictionary")

With oDic
For i = 1 To UBound(vIn, 1)
For j = 1 To UBound(vIn, 2) - 1 Step 2
If Not .Exists(vIn(i, j)) Then
n = n + 1
vOut(n, 1) = vIn(i, j)
vOut(n, 2) = Left(vIn(i, j + 1), 5)
vOut(n, 3) = 1
Else
vOut(.item(vIn(i, j)), 3) = vOut(.item(vIn(i, j)), 3) + 1
End If
Next j
Next i
End With

p = WorksheetFunction.RoundUp(n / nCol, 0)

With Sheets("Total")
.Activate
.UsedRange.Clear
With .Range("A1")
.Resize(, 4).Value = Array("Number", "Type", "Count", "Total Count")
For r = 1 To nCol
ReDim vOut2(1 To p, 1 To 3)
For i = (r - 1) * p + 1 To (r - 1) * p + p
k = k + 1
For j = 1 To 3
vOut2(k, j) = vOut(i, j)
Next j
Next i
.Offset(, (r - 1) * 4).Resize(, 4).Value = Array("Number", "Type", "Count", "Total Count")
.Offset(1, (r - 1) * 4).Resize(p, 3) = vOut2
k = 0
Next r
End With
End With

'Build the data dictionary
Dim oDicTmp As Object
Set oDicTmp = CreateObject("Scripting.Dictionary")

Dim strTmp As String
Dim nI As Integer
Dim nJ As Integer

For nI = 1 To Range("TABLEDATA").Columns.Count
For nJ = 1 To Range("TABLEDATA").Columns(nI).Rows.Count
strTmp = Range("TABLEDATA").Columns(nI).Rows(nJ).Value
If strTmp <> "" Then
strTmp = Left(strTmp, 5)
If Not (oDicTmp.Exists(strTmp)) Then
Else
oDicTmp.item(strTmp) = oDicTmp.item(strTmp) + 1
End If
End If
Next nJ
Next nI

'Start counting process
Dim nC As Long, nR As Long, nCTmp As Long, nVal As Long, strCellVal As String

For nC = 1 To nCol
For nR = 1 To p
nCTmp = (nC - 1) * 4 + 2
strCellVal = Cells(nR + 1, nCTmp).Value
If strCellVal <> "" Then
If oDicTmp.Exists(strCellVal) Then
nVal = oDicTmp(strCellVal)
Else
nVal = 0
End If
nCTmp = nCTmp + 2
Cells(nR + 1, nCTmp).Value = nVal
End If
Next nR
Next nC

End Sub
``````
0

LVL 3

Expert Comment

ID: 35043683
Hello Cartillo,

I have tested your revised code and found out that it could not work properly.  I am still investgating your two issues and will keep you posted when I am finished.

Regards,

Long
0

Author Comment

ID: 35043743
Thanks Long
0

LVL 3

Expert Comment

ID: 35046309
Hello Cartillo,

I have already solved the "missing data".  In regards to the "Object Defined Error" with large data, it happens due to the limitation in the number of rows and columns in all Excel versions before 2007.  There are 65536 rows and 256 columns only in all version before 2007.  When the code runs with large data, the total rows it needs to copy are over 65536 and hence, the error happens.  Starting from version 2007, the number of rows increases to 1,048,576 and the number of columns increases to 16,384.  It means the "Object Defined Error" is resolved by default with Excel 2007.  I have converted the workbook with large data to Excel 2007 format and enclosed it here for your reference.

If you have any question, please let me know.

Regards,

Long
SpeedData1---Large-Data.xlsm.zip
0

Author Comment

ID: 35065213
Hi Long,

Thanks for fixing the error. My PC runs using excel 2007, but the PC that I’m using for tracking this data is still using 2003 (xls). Hope you’ll convert this into xls format. I’ve tried but its not working. Sorry for troubling you.
0

Author Comment

ID: 35065464
Hi Long,

Since the problem happen because of rows, I’m planning to export data at Data and Validation sheets up to 65000 rows only. Hope with this arrangement I’m able to use .xls file.
0

LVL 3

Expert Comment

ID: 35066315
Hello Cartillo,

Please find the XLS version in the attached file.  In order to run, please remember to remove some rows so that the total rows does not exceed 65536.

If you need anything else, please let me know.

Regards,

Long
SpeedData1---Large-Data.xls.zip
0

Author Comment

ID: 35068067
Hi,

I have tested, for some reason I’m still getting Object Define Error at this line:

.Offset(1).Resize(n, 3) = vOut

0

LVL 3

Assisted Solution

longtruong earned 500 total points
ID: 35076888
Hello Cartillo,

The problem you were encountered is also related to the limitation in the number of rows.  I have put an extra IF statement in the code to check whether the number of rows exceeds 65536.  If yes, it will inform you abou the fact and stop the process nicely.

Please try and let me know if you still have any question.

Regards,

Long
SpeedData1---Large-Data.xls.zip
0

Author Comment

ID: 35077307
Hi Long,

Thanks for fixing this error and considering my request. I’ve rerun the code and crosschecked the whole data especially those data at “Data” sheet. Its not capturing the right sum total. I have highlighted those discrepancies in Red at Total sheet. By right the Total Count should shows total number of data that was duped at the “Data” sheet but its only shows “0”. Hope you will look at this error. Apology for dragging the Question.

SpeedData1---Large-Data.zip
0

LVL 3

Accepted Solution

longtruong earned 500 total points
ID: 35077861
Hello Cartillo,

The error happens because you have appended new rows to Data sheet without redefining TABLEDATA name.  For your information, in order for the code run correctly, you need to define an exact name "TABLEDATA" which covers all data that needed to check in Data sheet.  I have updated the TABLEDATA for you and the code now run properly.  Please see my updated example for more information.

Regards,

Long
SpeedData1---Large-Data.xls.zip
0

Author Closing Comment

ID: 35104500
Hi Long,

Thanks a lot for the superb code.
0

LVL 3

Expert Comment

ID: 35104654
Hello Cartillo,

It's my pleasure and thanks for the points.

Regards,

Long
0

Author Comment

ID: 35104754
Hi Long,

Hope you will consider this request Q; using the same data set but need to copy only matched data.

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_26879425.html
0

## Featured Post

Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.