aligning data lists with code

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

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
 
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?
 
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
 
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
 
Back
Top