View Single Post
  #25   Report Post  
Posted to microsoft.public.excel.programming
Clif McIrvin[_3_] Clif McIrvin[_3_] is offline
external usenet poster
 
Posts: 203
Default Align cells with same value - vba almost working

"Clif McIrvin" wrote in message
...
"Rick Rothstein" wrote in
message ...
[...]... those items were left overs from (several) previous attempts
to create the code and resulted from my failure to clean up my code
correctly. Thanks for noticing them.


I like the way you squeeze code until the excess stops dripping out
:-)

I may post back again this evening or sometime with the code I was
thinking up and ask for your thoughts comparison of the different
methods.


Well, it's "sometime" <grin.

Rick, (anyone else who cares to, for that matter!) I'd be much
interested in any comments you have on the merits (or "demerits") of
this approach contrasted with your approach.

Here's a copy of a reply to the OP I just posted in another branch of
this thread:

Here's another slightly different approach to solving your OP using
somewhat of a "brute force" attack in VBA; touching the worksheet itself
only to read in the original data and to write out the result. (I'm
simply working in the active worksheet - workbook and worksheet object
variables could easily be added.)

I tried to use enough line continuation characters so you don't have
problems with line wrap:

Sub AlignData()
'cm 3/17/11 using arrays
Dim C1in As Variant ' Initial Column A Values
Dim C2in As Variant ' Initial Column B Values
Dim Out As Variant ' Final Values
Dim LastC1in As Long ' Last Row
Dim LastC2in As Long
Dim ThisC1in As Long ' 'Current' Input Row
Dim ThisC2in As Long
Dim LastOut As Long ' 'Current' (Last Used) Output Row

LastC1in = Cells(Rows.Count, 1).End(xlUp).Row
LastC2in = Cells(Rows.Count, 2).End(xlUp).Row
With WorksheetFunction
C1in = .Transpose(Range(Cells(1, 1), Cells(LastC1in, 1)))
C2in = .Transpose(Range(Cells(1, 2), Cells(LastC2in, 2)))
End With

ThisC2in = 1
LastOut = 0
ReDim Out(1 To 2, 1 To 1) ' initialize variant array structure; _
'redim preserve fails without this

For ThisC1in = 1 To LastC1in
LastOut = LastOut + 1
ReDim Preserve Out(1 To 2, 1 To LastOut) ' columns, rows _
'because of how preserve works
Select Case C1in(ThisC1in) - IIf(ThisC2in LastC2in, _
C1in(ThisC1in), C2in(ThisC2in))
Case Is < 0 ' C2 is Larger: Copy C1, C2 = Empty
Out(1, LastOut) = C1in(ThisC1in)
Case Is = 0 ' Same or finished w/ C2, copy both
Out(1, LastOut) = C1in(ThisC1in)
Out(2, LastOut) = C2in(ThisC2in)
ThisC2in = ThisC2in + 1
Case Is 0 ' C1 is Larger: Copy C2, C1 = Empty
Out(2, LastOut) = C2in(ThisC2in)
ThisC2in = ThisC2in + 1
ThisC1in = ThisC1in - 1 ' C2 advanced, C1 must repeat
End Select 'Case C1in(ThisC1in) - C2in(ThisC2in)
Next ThisC1in '= 1 To LastC1in
Range(Cells(1), Cells(LastOut, 2)) = _
WorksheetFunction.Transpose(Out)

End Sub


--
Clif McIrvin

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