Same operations on a variable number of rows

  • Thread starter Thread starter Matt Silberstein
  • Start date Start date
M

Matt Silberstein

I am posting this to both the regular and the programming group
because I don't know if the solution requires programming. If not,
sorry and ignore this.

Anyway, here is my questions. I have a specific and then a more
general issues. I have a set of data that changes frequently. In
particular, the number of items change. What I want to do is get the
list of unique concatenations of the items. Now that part is easy. I
concatenate the cells. Copy as value. Then make a filter unique. But
that is lots of action on my part. I have to copy the concatenate
formula to a variable number of rows. I have to do the copy and paste
special. And I have to do the filter. Is there someway to make it more
automated? My idea, which may not fit in with excel, would be to have
something that looked in col A and B, concatenated everything as long
as there was something there, and wrote the value to col C. If it
could then filter and write that to D I would be very happy. I am as
interested in the general problem of dealing with variable number of
data items as this specific problem (which is just a sub-set of what I
am doing). I could do it with a DB, but that is much more complex a
problem and has its own issues in my case.

Anyway, TIA.
--
Matt Silberstein

All in all, if I could be any animal, I would want to be
a duck or a goose. They can fly, walk, and swim. Plus,
there there is a certain satisfaction knowing that at the
end of your life you will taste good with an orange sauce
or, in the case of a goose, a chestnut stuffing.
 
assuming data starts in A1 and there are no headers in the first row.

Sub GetUniques()
Dim rng As Range
Dim cell As Range
Dim rng1 As Range
Set rng = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))
For Each cell In rng
Cells(cell.Row, "C").Value = cell.Value & _
cell.Offset(0, 1).Value
Next
Cells(1, "C").Insert Shift:=xlShiftDown
Cells(1, "C").Value = "Header"
Set rng1 = Range(Cells(1, "C"), Cells(1, "C").End(xlDown))
rng1.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Cells(1, "D"), _
Unique:=True
Cells(1, "C").Resize(1, 2).Delete Shift:=xlShiftUp
End Sub

This method doesn't use concatenation and the results are not concatenated,
however the unique results are the same if you did concatenate them.


Sub GetUniquesAlternate()
Range("A1:B1").Insert Shift:=xlDown
Range("A1:B1").Value = _
Array("Header1", "Header2")
Range("A1").CurrentRegion.Resize(, 2) _
.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Cells(1, "C"), _
Unique:=True
Range("A1:D1").Delete Shift:=xlShiftUp
End Sub
 
Hi, Matt. This will concatenate Cols. A&B and write to C, then filter C for
your criterion and paste to D. Sorry - it doesn't do anything to handle
blanks in A and/or B. If that's a major problem, I;m sure it can be worked
out.

HTH
Ed

Sub Foo_CONCATENATE()

Dim LastRow As Long
Dim strFilter As String
Dim wks As Worksheet

Set wks = ActiveSheet
With wks
' Run down Col. A to find last row
LastRow = .Range("A65536").End(xlUp).Row
' Insert Concentate formula
.Range("C2").Formula = "=CONCATENATE(A2, B2)"
.Range("C2:C" & LastRow).FillDown
Calculate

' Get filter criterion
strFilter = InputBox("Enter filter criterion.")
' Filter
.Range("C1").Select
Selection.AutoFilter Field:=3, Criteria1:=strFilter
' Copy filtered range
.Range("C2:C" & LastRow).Copy
' Paste values
.Range("D2").PasteSpecial xlPasteValues, , SkipBlanks:=True
' Toggle Filter
.Range("A1").Select
Selection.AutoFilter

End With

End Sub
 
Just a heads up, but
think you misread:
What I want to do is get the list of unique concatenations of the items.

Autofilter won't do uniques. You have to use advanced filter.
 
Ouch! Thank you for pointing that out, Tom. I also tried it with numbers,
and found out concatenate writes as a text string, and numeric filter
operators (<, >) won't work. *sigh* I'll keep plugging! I'm bound to get
better - after all, I've learned most of what I know from you already!

Ed
 
assuming data starts in A1 and there are no headers in the first row.

Sub GetUniques()
Dim rng As Range
Dim cell As Range
Dim rng1 As Range
Set rng = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))
For Each cell In rng
Cells(cell.Row, "C").Value = cell.Value & _
cell.Offset(0, 1).Value
Next
Cells(1, "C").Insert Shift:=xlShiftDown
Cells(1, "C").Value = "Header"
Set rng1 = Range(Cells(1, "C"), Cells(1, "C").End(xlDown))
rng1.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Cells(1, "D"), _
Unique:=True
Cells(1, "C").Resize(1, 2).Delete Shift:=xlShiftUp
End Sub

This method doesn't use concatenation and the results are not concatenated,
however the unique results are the same if you did concatenate them.

I think I understand this enough to make it do what I want. Thanks for
a very large help.
Sub GetUniquesAlternate()
Range("A1:B1").Insert Shift:=xlDown
Range("A1:B1").Value = _
Array("Header1", "Header2")
Range("A1").CurrentRegion.Resize(, 2) _
.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Cells(1, "C"), _
Unique:=True
Range("A1:D1").Delete Shift:=xlShiftUp
End Sub

More compact, but harder for me to do more processing. Thanks again.


--
Matt Silberstein

All in all, if I could be any animal, I would want to be
a duck or a goose. They can fly, walk, and swim. Plus,
there there is a certain satisfaction knowing that at the
end of your life you will taste good with an orange sauce
or, in the case of a goose, a chestnut stuffing.
 
Back
Top