View Single Post
  #26   Report Post  
Posted to microsoft.public.excel.programming
Rick Rothstein Rick Rothstein is offline
external usenet poster
 
Posts: 5,934
Default Align cells with same value - vba almost working

That looks similar to what I posted the first time. I later retracted it
because, while it worked with the given data, it failed to work with this
set of data...

251120 251111
251140 272222
251145 293333
272505 294444
272535
291130
292100

Rick Rothstein (MVP - Excel)




"Clif McIrvin" wrote in message
...

"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