aligning data lists with code
Try this:
Sub ABCD()
Dim nodupes As New Collection
Dim rngrev As Range
Dim rng As Range
Dim rngbas As Range
Dim cell As Range
Dim r As Long
Dim item As Variant
Dim nodupesrev As New Collection
Dim e As Integer
Dim j As Long
'endbase = 37
'StartReview = endbase + 1
'NumberRows = StartReview + 50
Sheets("Data (altered)").Select
'Set rng = Range(Cells(2, 13), Cells(2, 13).End(xlDown))
'rng.Select
Set rngbas = Range("m2:m" & endbase)
rngbas.Select
On Error Resume Next
'For Each cell In rng
For Each cell In rngbas
nodupes.Add cell.Value, Key:=cell.Text
Next
On Error GoTo 0
r = 0
For Each item In nodupes
Debug.Print item 'i think this just prints result in intermediate window
r = r + 1
k = k + 1 ' this is added only for my experimentation to
'understand what is happening
Range("x2").Value = k 'should represent number of types found
Cells(r + 1, "y") = item
'Cells(r + 1, "z").Formula = "=Countif(" & _
rng.Address & "," & Cells(r + 1, "y").Address & ")"
Cells(r + 1, "z").Formula = "=Countif(" & _
rngbas.Address & "," & Cells(r + 1, "y").Address & ")"
' or
' Cells(r, "E").Value = Application.CountIf( _
' rng, item)
Next
Set rngrev = Range("m" & StartReview & ":m" & NumberRows)
rngrev.Select
On Error Resume Next
For Each cell In rngrev
nodupesrev.Add cell.Value, Key:=cell.Text
Next
On Error GoTo 0
r = 0
j = 0
For Each item In nodupesrev
Debug.Print item 'i think this just prints result in intermediate window
r = r + 1
e = e + 1
Range("af2").Value = e 'should represent number of types found
'this does not correlate the value to the table first
bFound = False
For u = 1 To nodupes.Count
If item = Cells(u + 1, "y") Then
' Cells(u + 1, "ab") = item
'Cells(r + 1, "z").Formula = "=Countif(" & _
rng.Address & "," & Cells(r + 1, "y").Address & ")"
Cells(u + 1, "aa").Formula = "=Countif(" & _
rngrev.Address & "," & Cells(u + 1, "y").Address & ")"
bFound = True
Exit For
End If
Next
If Not bFound Then
j = j + 1
Cells(nodupes.Count + 1 + j, "y") = item
Cells(nodupes.Count + 1 + j, "z").Formula = "=Countif(" & _
rngbas.Address & "," & Cells(nodupes.Count + 1 + j, "y").Address & ")"
Cells(nodupes.Count + 1 + j, "aa").Formula = "=Countif(" & _
rngrev.Address & "," & Cells(nodupes.Count + 1 + j, "y").Address & ")"
End If
' or
' Cells(r, "E").Value = Application.CountIf( _
' rng, item)
Next
End Sub
--
Regards,
Tom Ogilvy
"Papa Jonah" wrote in message
...
Tom,
Here is my code. It should look familiar to you. I have obviously added
to
it as I have experimented.
You asked about whether bread could be in the second set of data and not
in
the first. The answer is yes. My code, I do not think addresses that
possibility.
Dim nodupes As New Collection
Dim rngrev As Range
Dim rng As Range
Dim rngbas As Range
Dim cell As Range
Dim r As Long
Dim item As Variant
Dim nodupesrev As New Collection
Dim e As Integer
Sheets("Data (altered)").Select
'Set rng = Range(Cells(2, 13), Cells(2, 13).End(xlDown))
'rng.Select
Set rngbas = Range("m2:m" & endbase)
rngbas.Select
On Error Resume Next
'For Each cell In rng
For Each cell In rngbas
nodupes.Add cell.Value, Key:=cell.Text
Next
On Error GoTo 0
r = 0
For Each item In nodupes
Debug.Print item 'i think this just prints result in intermediate window
r = r + 1
k = k + 1 ' this is added only for my experimentation to understand what
is happening
Range("x2").Value = k 'should represent number of types found
Cells(r + 1, "y") = item
'Cells(r + 1, "z").Formula = "=Countif(" & _
rng.Address & "," & Cells(r + 1, "y").Address & ")"
Cells(r + 1, "z").Formula = "=Countif(" & _
rngbas.Address & "," & Cells(r + 1, "y").Address & ")"
' or
' Cells(r, "E").Value = Application.CountIf( _
' rng, item)
Next
Set rngrev = Range("m" & startreview & ":m" & numberrows)
rngrev.Select
For Each cell In rngrev
nodupesrev.Add cell.Value, Key:=cell.Text
Next
On Error GoTo 0
r = 0
For Each item In nodupesrev
Debug.Print item 'i think this just prints result in intermediate window
r = r + 1
e = e + 1
Range("af2").Value = e 'should represent number of types found
'this does not correlate the value to the table first
For u = 1 To 13
If item = Cells(u + 1, "y") Then
Cells(u + 1, "ab") = item
'Cells(r + 1, "z").Formula = "=Countif(" & _
rng.Address & "," & Cells(r + 1, "y").Address & ")"
Cells(u + 1, "ac").Formula = "=Countif(" & _
rngrev.Address & "," & Cells(u + 1, "ab").Address & ")"
End If
Next
' or
' Cells(r, "E").Value = Application.CountIf( _
' rng, item)
Next
"Tom Ogilvy" wrote:
It might be helpful if you posted the code you have now and where the
other
data is located. Also, would the other data have items ( ex: Bread)
that
did not exist in the first list - thus a separate list of uniques would
need
to be developed, or is it just a matter of counting the matches in the
new
data location to the first list of uniques?
--
Regards,
Tom Ogilvy
"Papa Jonah" wrote in message
...
Tom's stuff has been very helpful for developing a list of the
different
entries from a data range. I have been successful in doing just that.
However, I am wanting to expand it. What I currently am able to do is
to
develop a list such as:
vegetable 5
fruit 10
fish 2
meat 7
I am creating this from a list of data that falls within a certain
date
range.
What I want to do next is add to the above table information that
would
reflect data from another date range. What I would like to see is:
vegetable 5 2
fruit 10 3
fish 2 0
meat 7 2
(From here I can then make charts to compare time frames)
The difficulty I am having is getting the numbers in the third column
to
correctly correspond to the categories in the first column.
Any thoughts would be appreciated.
TIA
|