View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default 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