View Single Post
  #33   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
...
"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



The code I posted earlier only returned the correct result if both
columns contained the same final value.

This has been revised and tightened up somewhat .... still not as
compact as the solution that Rick posted, though. Like Rick's solution,
this will return the expected result regardless of which column contains
more values. Unlike Rick's solution, this does require that the columns
are already sorted (although he did show you how to sort the data at the
beginning of the procedure.)

Sub AlignData()
'cm 3/18/11 using arrays
Dim ColAin As Variant ' Initial Column A Values
Dim ColBin As Variant ' Initial Column B Values
Dim Out As Variant ' Final Values
Dim LastColAin As Long ' Last Row
Dim LastColBin As Long
Dim LastOut As Long ' 'Current' (Last Used) Output Row
Dim idxColAin As Long ' 'Current' Input Row Index Pointer
Dim idxColBin As Long
Dim ThisColAin As Variant ' 'Current' Input Value
Dim ThisColBin As Variant

With WorksheetFunction
ColAin = .Transpose(Range("A1:A" & Cells(Rows.Count, _
"A").End(xlUp).Row + 1))
ColBin = .Transpose(Range("B1:B" & Cells(Rows.Count, _
"B").End(xlUp).Row + 1))
End With

LastOut = 0
idxColAin = 1
idxColBin = 1

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

Do
LastOut = LastOut + 1
ReDim Preserve Out(1 To 2, 1 To LastOut) ' columns, rows _
'because of how preserve works

ThisColAin = ColAin(idxColAin)
ThisColBin = ColBin(idxColBin)
If IIf(IsEmpty(ThisColBin), ThisColAin, ThisColBin) _
IIf(IsEmpty(ThisColAin), ThisColBin, ThisColAin) Then
' ColB is Larger: Copy ColA, ColB = Empty
Out(1, LastOut) = ThisColAin
idxColAin = idxColAin + 1
ElseIf IIf(IsEmpty(ThisColBin), ThisColAin, ThisColBin) _
= ThisColAin Then
' Same, copy both
Out(1, LastOut) = ThisColAin
Out(2, LastOut) = ThisColBin
idxColAin = idxColAin + 1
idxColBin = idxColBin + 1
Else ' ColA is Larger: Copy ColB, ColA = Empty
Out(2, LastOut) = ThisColBin
idxColBin = idxColBin + 1
End If ' ThisColBin <?? ThisColAin
Loop Until IsEmpty(ThisColAin) And IsEmpty(ThisColBin)
Range(Cells(1), Cells(LastOut, 2)) = _
WorksheetFunction.Transpose(Out)

End Sub




--
Clif McIrvin

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