View Single Post
  #24   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

"bpascal123" wrote in message
...
--
Clif McIrvin

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


Hi,

I take these advices seriously. I'm currently having a difficult time
dealing with range of cells instead of one by one cells... The code in
this discussion helps to understand handling data into arrays
variables. I haven't made it to that level and it seems I need to
practice on specific tasks. I hope to get trought this first step and
not feel discouraged :( ):


In my first six months or so of beginning to use VBA and macros I
experienced a lot of frustration. In my case, I had prior programming
experience but I knew next to nothing about either Excel or Visual
Basic. Because of the excellent advice and shared knowledge I found here
in these newsgroups I made it through the frustrations, and now feel
quite comfortable with the object model -- and, I must add, I'm
continually learning new things here! So -- don't expect too much of
yourself too soon, and you _will_ find yourself climbing the slopes of
the "learning curve"!

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 :-)