Using Collection to also capture range adjacent

[dave.cuthill]

On an earlier post I received some very helpful advice regarding the
merging of ranges from various worksheets. I have posted the code
below. I am now wondering if it is also possible to capture the values
that are in the adjacent column of each of these ranges and have them
transferred adjacent to the resulting consolidated range.

I hope that makes sense to someone.

David



Dim coll As Collection


Sub main()
Set coll = New Collection
Dim r As Range
Set r = Sheets("Sheet1").Range("A1:A10")
Call Builder(r)
Set r = Sheets("Sheet2").Range("B1:B10")
Call Builder(r)
Set r = Sheets("Sheet3").Range("C1:C10")
Call Builder(r)
Set r = Sheets("Sheet1").Range("B1")
Call Displayer(r)
Set coll = Nothing
End Sub


Sub Builder(r As Range)
Dim arr
arr = r
On Error Resume Next
For i = 1 To UBound(arr)
coll.Add arr(i, 1), CStr(arr(i, 1))
Next i
End Sub


Sub Displayer(r As Range)
MsgBox coll.Count
For i = 1 To coll.Count
r.Value = coll.Item(i)
Set r = r.Offset(1, 0)
Next
End Sub

 

[dave.cuthill]

Okay I have been working on this a bit more and now have the following
code prepared that does what I want except for outputing both parts of
the range. I have added a discontinuous range to the collection but
now cannot figure out what I need to do to extract the range into 2
adjoining columns.

Dim coll As Collection

Sub main_merge()
'Set coll = New Collection
Dim r As Range
Dim nme As Name
Dim rngname As String
Set coll = Nothing
For Each c In Range("Category").Cells
Set coll = New Collection
rngname = c.Value
rngvalue = c.Value + "_"
MsgBox rngvalue
For Each nme In ActiveWorkbook.Names
If InStr(1, nme.Name, rngvalue) Then
Set r = Range(nme.Name)
Set r = Union(r, Range(nme.Name).Offset(0, 3))
Call Builder(r)
End If
Next nme

Call Displayer(r, rngname)
'Set coll = Nothing
Next c
End Sub

Sub Builder(r As Range)
Dim arr
arr = r
On Error Resume Next
For i = 1 To UBound(arr)
coll.Add arr(i, 1), CStr(arr(i, 1))
Next i
End Sub

Sub Displayer(r As Range, rngname As String)
Dim LastCell As Range

With Worksheets("dropdown")
Set LastCell = .Cells(.Rows.Count, "B").End(xlUp)
If IsEmpty(LastCell) Then
'do nothing
Else
Set LastCell = LastCell.Offset(1, 0)
End If
End With
j = LastCell.Row
j_top = j


For i = 1 To coll.Count
If coll.Item(i) <> "" Then

'This is the part I cannot figure out - the collection item holds a
range that is 2 columns wide.
'How do I extract both columns of information

Sheets("Dropdown").Cells(j, 2).Value = coll.Item(i)
j = j + 1
End If

Next
k = j - 1
ThisWorkbook.Names.Add Name:=rngname, _
RefersTo:=Worksheets("dropdown").Range("B" & j_top & ":B" & k)

Set coll = Nothing
End Sub

 

[Clif McIrvin]

Something about your message formatting is making my reply quotation
(OE) fail ... so I'm going to preface my comments (inline) with **

I've not worked with collections before, and not certain I'd have
started out this way, but I have a couple suggestions you can try. Read
on:

Okay I have been working on this a bit more and now have the following
code prepared that does what I want except for outputing both parts of
the range. I have added a discontinuous range to the collection but
now cannot figure out what I need to do to extract the range into 2
adjoining columns.

Dim coll As Collection

Sub main_merge()
'Set coll = New Collection
Dim r As Range
Dim nme As Name
Dim rngname As String
Set coll = Nothing
For Each c In Range("Category").Cells
Set coll = New Collection
rngname = c.Value
rngvalue = c.Value + "_"
MsgBox rngvalue
For Each nme In ActiveWorkbook.Names
If InStr(1, nme.Name, rngvalue) Then
Set r = Range(nme.Name)
Set r = Union(r, Range(nme.Name).Offset(0, 3))

** right here, I'd combine the two " Set r " statements as follows:

Set r = Union(Range(nme.Name), Range(nme.Name).Offset(0, 3))

**
Call Builder(r)
End If
Next nme

Call Displayer(r, rngname)
'Set coll = Nothing
Next c
End Sub

Sub Builder(r As Range)
Dim arr
arr = r
On Error Resume Next
For i = 1 To UBound(arr)
coll.Add arr(i, 1), CStr(arr(i, 1))
Next i
End Sub

Sub Displayer(r As Range, rngname As String)
Dim LastCell As Range

With Worksheets("dropdown")
Set LastCell = .Cells(.Rows.Count, "B").End(xlUp)
If IsEmpty(LastCell) Then
'do nothing
Else
Set LastCell = LastCell.Offset(1, 0)
End If
End With
j = LastCell.Row
j_top = j


For i = 1 To coll.Count
If coll.Item(i) <> "" Then

'This is the part I cannot figure out - the collection item holds a
range that is 2 columns wide.
'How do I extract both columns of information

** here, I'd think this might work for you:

set r = coll.Item(i)

Sheets("Dropdown").Cells(j, 2).Value = r.cells(1)
Sheets("Dropdown").Cells(j, 3).Value = r.cells(2)

** or, if you want the two values combined in a single cell

Sheets("Dropdown").Cells(j, 2).Value = _
cstr(r.cells(1)) & " " & cstr(r.cells(2))

'Sheets("Dropdown").Cells(j, 2).Value = coll.Item(i)
j = j + 1
End If

Next
k = j - 1
ThisWorkbook.Names.Add Name:=rngname, _
RefersTo:=Worksheets("dropdown").Range("B" & j_top & ":B" & k)

Set coll = Nothing
** set r = nothing
End Sub

** Good luck!
** Clif

 

[dave.cuthill]

Thanks for the reply but I can't seem to get your suggestion to work.
The code keeps on giving an error 424 about Object Required for the
statement

Set r = coll.Item(i)

 

[Clif McIrvin]

Thanks for the reply but I can't seem to get your suggestion to work.
The code keeps on giving an error 424 about Object Required for the
statement

Set r = coll.Item(i)

** I was making the assumption that Builder(r) was putting range
objects into the collection. One of the downsides of working with
variant data types is that you don't necessarily know what is really
happening "under the covers". You could put a breakpoint in your code
and use the locals window (View | Locals from the VBE menu)
and / or "? typename(xxx)" from the immediate window to examine the data
type of the various variables in the code. For instance the "Dim arr /
arr = r" statement pair in Builder(r) .... r is typed as a range; but
arr is unspecified so is a variant. The use of UBound(arr) shows that
the programmer expects arr to actually be an array ... but the question
is, an array of what?

I have found that by examining variables using the locals window I can
oftentimes solve difficulties that turned out to be the result of me not
really understanding what VBA was actually doing with my variables.

HTH
Clif

 

[dave.cuthill]

Thanks for the suggestions but I have resigned myself to concatenating
the 2 range values, loading this into the collection, and then
breaking then apart again at the other end and placing them in the
corresponding cells.

Using typename for arr just returned "variant" which didn't seem to
really help much.

 

[Clif McIrvin]

Thanks for the suggestions but I have resigned myself to concatenating
the 2 range values, loading this into the collection, and then
breaking then apart again at the other end and placing them in the
corresponding cells.

Using typename for arr just returned "variant" which didn't seem to
really help much.

** You could try using this (untested) code for Builder instead of what
you have, which will add the value of each cell in your range as a new
item to the collection. This way you wouldn't need to concatenate, then
break the two values. This code should also preserve Excel's data type
for the cell's data (string, number, date/time ...)

Sub Builder(r As Range)
Dim c As Variant ' cell
On Error Resume Next
For Each c In r
coll.Add c.Value, CStr(c.Value)
Next i
End Sub

HTH!
-- Clif

 

[Clif McIrvin]

Thanks for the suggestions but I have resigned myself to concatenating
the 2 range values, loading this into the collection, and then
breaking then apart again at the other end and placing them in the
corresponding cells.

Using typename for arr just returned "variant" which didn't seem to
really help much.


** I found some time to try running your code ... and I'm puzzled: When
I ran your code as modified (below), nothing was added to the
collection????

I created a new workbook and populated A1:C7 with sample data then
selected A1.

I opened the VBE and pasted this code with a breakpoint set at <bp>, and
ran with F5. Opening the locals window and single-stepping from the
breakpoint confirmed that the union created a range with two cells; but
the arr = r resulted in a simple variant with the contents of A1; and
nothing was added to the collection. So: I don't seem to be able to see
what you are seeing.

'Option Explicit

Dim coll As Collection

Sub main_merge()
Set coll = New Collection
Dim r As Range
Dim nme As Name
Dim rngname As String
'Set coll = Nothing
'For Each c In Range("Category").Cells
'Set coll = New Collection
'rngname = c.Value
'rngvalue = c.Value + "_"
'MsgBox rngvalue
'For Each nme In ActiveWorkbook.Names
'If InStr(1, nme.Name, rngvalue) Then
' Set r = Range(nme.Name)
' Set r = Union(r, Range(nme.Name).Offset(0, 3))
<bp> Set r = Selection
Set r = Union(r, r.Offset(0, 2))
Call Builder(r)
'End If
'Next nme

'Call Displayer(r, rngname)
''Set coll = Nothing
'Next c
End Sub

Sub Builder(r As Range)
Dim arr
arr = r
On Error Resume Next
For i = 1 To UBound(arr)
coll.Add arr(i, 1), CStr(arr(i, 1))
Next i
End Sub

 

[dave.cuthill]

I have looked at this some more using your suggestions of the locals
windows and I think I have figured out part of the problem. The unions
method does not seem to be compatible with the collections method. If
I make a union of the two discontinuous ranges the "array" that is
created is only one element per item (it only contains the data from
the first part of the joined range). But if I expand the range by
using something like set r = range(r,r.offset(,2)) - which would
include the column between the 2 desired ranges - then I end up with 3
elements per item with the arr variable.

I also do see data being placed in the collection using you simplified
example code - I think you need to make your selection as a1:a7 in
order for it populate something into the collection.

 

[Clif McIrvin]

Ah ... so we're both learning! It's great when the ng's work like this
<smile>

After reading your reply I did some more looking. The collection doesn't
care what you put into it ... you can put the range into the collection
if you want to: [ coll.Add r ] would add the range itself as the
collection item. Likewise, [ coll.Add arr ] adds the array as the item.
The problem seems to be that [ arr = r ] doesn't pick up the succeding
regions of a Union range.

set r = union(range("a1:a7"),range("c1:c7"))
For Each c In r
coll.Add c.Value, CStr(c.Value)
Next c

where c is a variant will add all the cell values of a union range to
the collection; but it appears to add them in area order - so when you
walk through the collection you will get all column a, then column c;
whereas [ set r = range("a1:c7") ] I believe would give you the three
columns in row 1, then row 2, etc.

I did some digging, and learned how to discover the upper bound of the
second (nth) array dimension ... the code below illustrates what I
found:

Sub Builder(r As Range)
Dim arr
arr = r

On Error Resume Next
For i = 1 To UBound(arr)
j = UBound(arr, 2)
if j = Empty then ' no multi-dimensions
j = 1
End If
For j = 1 To j
coll.Add arr(i, j), CStr(arr(i, j))
Next j
Next i
End Sub

Another possibility is to use the range directly and not even bother
with the variant array:

For i = 1 To r.Rows.Count
For j = 1 To r.Columns.Count
'coll.Add r.Cells(i, j).Value, CStr(r.Cells(i, j).Value)
coll.Add r.Cells(i, j).Value
Next j
Next i

The line I commented out causes an error if there is a duplicate value
in any cell, causing that cell to not be added to the collection.
Because of the [ On Error Resume Next ] any duplicate values are skipped
without warning.

This method should process union ranges as you expect.

So ... there are many options here.

Good luck!

Glad I was able to help.

--
Clif

I have looked at this some more using your suggestions of the locals
windows and I think I have figured out part of the problem. The unions
method does not seem to be compatible with the collections method. If
I make a union of the two discontinuous ranges the "array" that is
created is only one element per item (it only contains the data from
the first part of the joined range). But if I expand the range by
using something like set r = range(r,r.offset(,2)) - which would
include the column between the 2 desired ranges - then I end up with 3
elements per item with the arr variable.

I also do see data being placed in the collection using you simplified
example code - I think you need to make your selection as a1:a7 in
order for it populate something into the collection.

 

[dave.cuthill]

Thanks - I knew it had to work something like that but I didn't know
well enough about what it was doing to completely grasp it.

Ah ... so we're both learning!  It's great when the ng's work like this
<smile>

After reading your reply I did some more looking. The collection doesn't
care what you put into it ... you can put the range into the collection
if you want to: [ coll.Add r ] would add the range itself as the
collection item. Likewise, [ coll.Add arr ] adds the array as the item.
The problem seems to be that [ arr = r ] doesn't pick up the succeding
regions of a Union range.

set r = union(range("a1:a7"),range("c1:c7"))
For Each c In r
   coll.Add c.Value, CStr(c.Value)
Next c

where c is a variant will add all the cell values of a union range to
the collection; but it appears to add them in area order - so when you
walk through the collection you will get all column a, then column c;
whereas [ set r = range("a1:c7") ] I believe would give you the three
columns in row 1, then row 2, etc.

I did some digging, and learned how to discover the upper bound of the
second (nth) array dimension ... the code below illustrates what I
found:

Sub Builder(r As Range)
Dim arr
arr = r

On Error Resume Next
  For i = 1 To UBound(arr)
  j = UBound(arr, 2)
    if  j = Empty then ' no multi-dimensions
        j = 1
    End If
  For j = 1 To j
    coll.Add arr(i, j), CStr(arr(i, j))
  Next j
  Next i
End Sub

Another possibility is to use the range directly and not even bother
with the variant array:

  For i = 1 To r.Rows.Count
  For j = 1 To r.Columns.Count
    'coll.Add r.Cells(i, j).Value, CStr(r.Cells(i, j).Value)
    coll.Add r.Cells(i, j).Value
  Next j
  Next i

The line I commented out causes an error if there is a duplicate value
in any cell, causing that cell to not be added to the collection.
Because of the [ On Error Resume Next ] any duplicate values are skipped
without warning.

This method should process union ranges as you expect.

So ... there are many options here.

Good luck!

Glad I was able to help.

--
Clif


I have looked at this some more using your suggestions of the locals
windows and I think I have figured out part of the problem. The unions
method does not seem to be compatible with the collections method. If
I make a union of the two discontinuous ranges the "array" that is
created is only one element per item (it only contains the data from
the first part of the joined range). But if I expand the range by
using something like set r = range(r,r.offset(,2)) - which would
include the column between the 2 desired ranges - then I end up with 3
elements per item with the arr variable.

I also do see data being placed in the collection using you simplified
example code - I think you need to make your selection as a1:a7 in
order for it populate something into the collection.

<[email protected]> wrote in message

Thanks for the suggestions but I have resigned myself to concatenating
the 2 range values, loading this into the collection, and then
breaking then apart again at the other end and placing them in the
corresponding cells.

Using typename for arr just returned "variant" which didn't seem to
really help much.

** I found some time to try running your code ... and I'm puzzled:
When
I ran your code as modified (below), nothing was added to the
collection????

I created a new workbook and populated A1:C7 with sample data then
selected A1.

I opened the VBE and pasted this code with a breakpoint set at <bp>,
and
ran with F5. Opening the locals window and single-stepping from the
breakpoint confirmed that the union created a range with two cells;
but
the arr = r resulted in a simple variant with the contents of A1; and
nothing was added to the collection. So: I don't seem to be able to
see
what you are seeing.

'Option Explicit

Dim coll As Collection

Sub main_merge()
Set coll = New Collection
Dim r As Range
Dim nme As Name
Dim rngname As String
'Set coll = Nothing
'For Each c In Range("Category").Cells
'Set coll = New Collection
'rngname = c.Value
'rngvalue = c.Value + "_"
'MsgBox rngvalue
'For Each nme In ActiveWorkbook.Names
'If InStr(1, nme.Name, rngvalue) Then
' Set r = Range(nme.Name)
' Set r = Union(r, Range(nme.Name).Offset(0, 3))
<bp> Set r = Selection
Set r = Union(r, r.Offset(0, 2))
Call Builder(r)
'End If
'Next nme

'Call Displayer(r, rngname)
''Set coll = Nothing
'Next c
End Sub

Sub Builder(r As Range)
Dim arr
arr = r
On Error Resume Next
For i = 1 To UBound(arr)
coll.Add arr(i, 1), CStr(arr(i, 1))
Next i
End Sub

(clare reads his mail with moe, nomail feeds the bit bucket

--
Clif McIrvin

(clare reads his mail with moe, nomail feeds the bit bucket - Hide quoted text -

- Show quoted text -