Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5
Default Align cells with same value - vba almost working

Hi cyberspace,

I have spent quite some time trying to make this work but at this
point from adding many msgbox checks, using the watch window for
variables values everything seems coherent to me.

I have 2 columns with sorted identical and not identical numercial
values in both columns :

col.A col.B
251120 251130
251140 272505
251145 291101
272505 292100
272535
291130
292100

I need to align identical value and to place single value alone on
one
row just like below :

251120
251130
251140
251145
272505 272505
272535
291101
291130
292100 292100

Now with the vba code, I get this :

Option Explicit
Option Base 1

Public Sub RowMatching()

Dim wkb As Workbook
Dim wks As Worksheet
Set wkb = Workbooks("code_row_v2.xls")
Set wks = wkb.Worksheets("Sheet1")
Dim trouve As Boolean
Dim LigCol1 As Integer 'numéro de ligne pour la premiere colonne
Dim LigCol2 As Integer 'numéro de ligne pour la seconde colonne
Dim LastRow As Long
Dim tmp
Dim Numligne(256) As Long
Dim marchehaute As Integer
Dim marchebasse As Integer
Dim marche As Integer

wks.Cells(1, 1).Select
LastRow = 0
LigCol1 = 1
While wks.Cells(LigCol1, 1) < ""
LastRow = LastRow + 1
LigCol1 = LigCol1 + 1
Wend
LigCol1 = 1
wks.Cells(LigCol1, 1).Select

While LigCol1 <= LastRow '''MAIN LOOP

Numligne(LigCol1) = wks.Cells(LigCol1, 1)
'MsgBox wks.Cells(LigCol1, 1)

For LigCol2 = 1 To LastRow
If Numligne(LigCol1) = wks.Cells(LigCol2, 2) Then '2a-IF7
If LigCol2 < LigCol1 Then '3a-IF9
Cells(LigCol2, 2).Select
marchehaute = LigCol1 - LigCol2
marche = 1
While marche <= marchehaute
Selection.Insert shift:=xlDown
marche = marche + 1
Wend
ElseIf LigCol2 LigCol1 Then
Cells(LigCol1, 1).Select
marchebasse = LigCol2 - LigCol1
marche = 1
While marche <= marchebasse
Selection.Insert shift:=xlDown
marche = marche + 1
LastRow = LastRow + 1
Wend
End If '3a-IF9
End If '2a-IF7
Next LigCol2
LigCol1 = LigCol1 + 1

Wend '''END MAIN LOOP

LigCol1 = 1
wks.Cells(LigCol1, 1).Select

''SECONDARY LOOP TO INSERT ROW FOR REMAINING NON IDENTICAL VALUES
FOUND ONTO SAME ROWS

For LigCol1 = 1 To LastRow '

MsgBox wks.Cells(LigCol1, 1) & " - " & wks.Cells(LigCol1, 2)
If Not IsEmpty(wks.Cells(LigCol1)) Then
If wks.Cells(LigCol1, 1).Value < wks.Cells(LigCol1, 2).Value
Then
Rows(LigCol1).Select
Selection.Insert shift:=xlDown
Cells(LigCol1 + 1, 1).Select
Selection.Cut
Cells(LigCol1, 1).Select
ActiveSheet.Paste
LastRow = LastRow + 1
End If
End If '2b-IF5

Next LigCol1 '''END SECONDARY LOOP

MsgBox LastRow

End Sub

Variable names are in french but it's easy : consider marche is
floor : marchebasse = lowerfloor, marchehaute = upperfloor... in fact
marche means step but steps has many meaning in english and is a vba
keyword as well..., here it would
be stairway.

Ok, this is what I get when i run the code from above :

251120
251130
251140
251145
272505 272505
272535 291101
291130
292100 292100

Although, the switch is completed for values 251120 and 251130
initialy on the same row, they are now on 2 distinct rows as stated
in For LigCol1 = 1 To LastRow loop .

But when it comes to values 272535 and 291101, no new rows is added
as
it should for two different values on the same row. msgbox even show
the loop is going though these values as with 251120 and 251130
Could you point where I am missing something?

I would very much appreciate to understand why it's not working as
intended as it seems coherent from the msgbox checks when running it.
I think something is messing in the secondary loop block code.

Thanks,
Cyberuser
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default Align cells with same value - vba almost working

I tried this using your values and came up with the following result:

251120
251130
251140
251145
272505 272505
272535
291101
291130
292100 292100

The code...

Sub AlignLikeRows()
Dim rng1 As Range, rng2 As Range, c As Range, c1 As Range, c2 As
Range
Dim v As Variant

Set rng1 = Range("A:A"): Set rng2 = Range("B:B")
rng1.Sort key1:=rng1.Cells(1), order1:=xlAscending
rng2.Sort key1:=rng2.Cells(1), order1:=xlAscending

For Each c In rng2
If Not IsEmpty(c) Then
If Not c.Value = c.Offset(, -1).Value And _
Not c.Offset(, -1) = "" Then
If Not c.Value = v Then
v = c.Value: c = ""
Set c2 = rng1.Find(what:=v, _
after:=rng1.Cells(1), _
lookat:=xlWhole)
If Not c2 Is Nothing Then
c2.Offset(, 1).Insert shift:=xlDown
c2.Offset(, 1).Value = v
Else '//not found so insert it where it belongs
For Each c1 In rng1
If c1 v Then
c1.EntireRow.Insert: c1.Offset(-1, 1) = v: Exit For
End If
Next
End If
End If
End If
End If
Next
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc


  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,059
Default Align cells with same value - vba almost working

On Mar 12, 3:58*pm, bpascal123 wrote:
I have 2 columns with sorted identical and not identical
numercial values in both columns :
col.A * * * col.B
251120 *251130
251140 *272505
251145 *291101
272505 *292100

[....]
I need to align identical value and to place single value
alone on one row just like below :
251120
* * * * * * * * 251130
251140
251145
272505 *272505


The following macro avoids Insert Shift:=xlDown, which can be very
inefficient.

I assume that there is no useful data below the contiguous data in
columns A and B which are to aligned as you specify.

If that assumption is incorrect, it is easy to add the Insert
Shift:=xlDown. But in that case, it would better to change the
implementation fill the aligned data into local arrays first and to
make other prudent design changes.

Let me know if the design changes are needed.

-----

Option Explicit

Sub doit()
Dim ra As Range, rb As Range, cola, colb
Dim na As Long, nb As Long
Dim minrow As Long, maxrow As Long
Dim r As Long, ia As Long, ib As Long
Dim oldcalc

oldcalc = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

#If 0 Then
'** if you wish, delete #if and #endif lines
Workbooks("code_row_v2.xls").Worksheets("Sheet1"). Active
#End If

'** ra and rb are first nonblank data to last
'** contiguous nonblank data in each column.
Set ra = Range(Range("a1").End(xlDown), _
Range("a1").End(xlDown).End(xlDown))
Set rb = Range(Range("b1").End(xlDown), _
Range("b1").End(xlDown).End(xlDown))

'** copy ra into cola(1 to na,1 to 1)
'** and rb into colb(1 to nb,1 to 1)
cola = ra: na = ra.Count
colb = rb: nb = rb.Count

'** assume ra and rb are each sorted
ReDim res(1 To na + nb, 1 To 3)
minrow = IIf(ra.Row <= rb.Row, ra.Row, rb.Row)
r = minrow - 1
ia = 1: ib = 1
Do
r = r + 1
If cola(ia, 1) < colb(ib, 1) Then
res(r, 1) = cola(ia, 1): ia = ia + 1
ElseIf cola(ia, 1) colb(ib, 1) Then
res(r, 3) = colb(ib, 1): ib = ib + 1
Else
res(r, 1) = cola(ia, 1): ia = ia + 1
res(r, 2) = colb(ib, 1): ib = ib + 1
End If
Loop Until ia na Or ib nb
For ia = ia To na
r = r + 1: res(r, 1) = cola(ia, 1)
Next
For ib = ib To nb
r = r + 1: res(r, 3) = colb(ib, 1)
Next

'** clear maximum number of rows in 3 columns.
'** assume there is no useful data below ra and rb
maxrow = minrow + r - 1
If maxrow < ra.Row + na Then maxrow = ra.Row + na
If maxrow < rb.Row + nb Then maxrow = rb.Row + nb
Range(Cells(minrow, 1), Cells(maxrow, 3)).ClearContents
Range(Cells(minrow, 1), Cells(minrow + r - 1, 3)) = res
Application.EnableEvents = True
Application.Calculation = oldcalc
Application.ScreenUpdating = True
End Sub
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,059
Default Align cells with same value - vba almost working

Errata....

On Mar 12, 8:57*pm, joeu2004 wrote:
If that assumption is incorrect, it is easy to add the Insert
Shift:=xlDown. *But in that case, it would better to change
the implementation fill the aligned data into local arrays
first and to make other prudent design changes.


Actually, I already made the change to use local arrays; more
efficient anyway. The needed adjustment is the appropriate Insert
Shift:=xlDown operations.

Let me know if you want that.
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,934
Default Align cells with same value - vba almost working

This macro appears to do what you asked for...

Sub AlignColumnData()
Dim M As Long, D As Long, Rw As Long, Main As Variant, Data As Variant
With WorksheetFunction
Main = .Transpose(Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row))
Data = .Transpose(Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row))
End With
Range("A:B").Clear
M = LBound(Main)
D = LBound(Data)
Do While M + D <= UBound(Main) + UBound(Data)
Rw = Rw + 1
If Main(M) = Data(D) Then
Range("A" & Rw).Resize(1, 2).Value = Main(M)
M = M + 1
D = D + 1
ElseIf Main(M) < Data(D) Then
Range("A" & Rw).Value = Main(M)
M = M + 1
Else
Range("A" & Rw).Offset(0, 1).Value = Data(D)
D = D + 1
End If
Loop
End Sub

Rick Rothstein (MVP - Excel)


  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,934
Default Align cells with same value - vba almost working

I should point out that my previously posted code requires the two columns
to be sorted (as the OP indicated they were). If they are not sorted (and
you do not want to do that step yourself), then you could use this macro
instead of the one I posted earlier (it takes care of the sorting for
you)...

Sub AlignColumnData()
Dim M As Long, D As Long, Rw As Long, Main As Variant, Data As Variant
Columns("A").Sort Range("A1"), xlAscending
Columns("B").Sort Range("B1"), xlAscending
With WorksheetFunction
Main = .Transpose(Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row))
Data = .Transpose(Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row))
End With
Range("A:B").Clear
M = LBound(Main)
D = LBound(Data)
Do While M + D <= UBound(Main) + UBound(Data)
Rw = Rw + 1
If Main(M) = Data(D) Then
Range("A" & Rw).Resize(1, 2).Value = Main(M)
M = M + 1
D = D + 1
ElseIf Main(M) < Data(D) Then
Range("A" & Rw).Value = Main(M)
M = M + 1
Else
Range("A" & Rw).Offset(0, 1).Value = Data(D)
D = D + 1
End If
Loop
End Sub

Rick Rothstein (MVP - Excel)

  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,934
Default Align cells with same value - vba almost working

Here are slightly shorter versions of my code, one assuming the data in both
columns are in sorted order before the macro is run and the other allowing
the data to be sorted or not sorted...

'===================================
' Data Pre-sorted
'===================================
Sub AlignColumnData()
Dim M As Long, D As Long, Rw As Long, TempM As Long, Main, Data
With WorksheetFunction
Main = .Transpose(Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row))
Data = .Transpose(Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row))
Range("A:B").Clear
M = LBound(Main)
D = LBound(Data)
Do While M + D <= UBound(Main) + UBound(Data)
Rw = Rw + 1
Range("A" & Rw).Offset(0, -(Main(M) Data(D))).Resize(1, _
1 - (Main(M) = Data(D))) = .Min(Main(M), Data(D))
TempM = Main(M)
M = M - (Main(M) <= Data(D))
D = D - (TempM = Data(D))
Loop
End With
End Sub

'===================================
' Data Not Necessarily Sorted
'===================================
Sub AlignColumnData()
Dim M As Long, D As Long, Rw As Long, TempM As Long, Main, Data
Columns("A").Sort Range("A1"), xlAscending
Columns("B").Sort Range("B1"), xlAscending
With WorksheetFunction
Main = .Transpose(Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row))
Data = .Transpose(Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row))
Range("A:B").Clear
M = LBound(Main)
D = LBound(Data)
Do While M + D <= UBound(Main) + UBound(Data)
Rw = Rw + 1
Range("A" & Rw).Offset(0, -(Main(M) Data(D))).Resize(1, _
1 - (Main(M) = Data(D))) = .Min(Main(M), Data(D))
TempM = Main(M)
M = M - (Main(M) <= Data(D))
D = D - (TempM = Data(D))
Loop
End With
End Sub


Rick Rothstein (MVP - Excel)

  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5
Default Align cells with same value - vba almost working

Hi,

Thanks for your code.
I went through part of it not without difficulties. I should have told
first it's my first vba code from a personal task...and i'm not really
aware of vba objects that's why most code here is shorter than mine
and seems a lot more efficient. I'll try to read them further.
However, i find it easier to learn vba code while implementing a
personal task rather than from reading lines of code. Any further
advice for this feeling?

From what I can understand, I should use less the select method and
use more the offset property. It would quite change the design of the
code and programming habits (I have a 2-3 years programming experience
with non-object languages). Would learning C++ help to find vba
easier?

So, I have found a fix on the secondary loop that makes the code work,
see 'A
However, I don't know if it's as rock solid as what I can find from
average and experts codes. Whatsoever, i know it's not efficient. I
understand I should get some training with vba arrays and the job done
in vba array.

Are vba arrays treated in segment data or heap or stack memory. Are
variant and fixed size arrays treated the same?

I have also replaced the :
select and selection.insert shift:=xldown
with :
Cells(LigCol1, 1).EntireRow.Insert shift:=xlDown in the secondary
loop.

Below is the code:


Option Explicit
Option Base 1


Public Sub RowMatching()

Dim wkb As Workbook
Dim wks As Worksheet
Set wkb = Workbooks("code_row_v2.xls")
Set wks = wkb.Worksheets("Sheet1")

Dim trouve As Boolean

Dim LigCol1 As Integer 'numéro de ligne pour la premiere colonne
Dim LigCol2 As Integer 'numéro de ligne pour la seconde colonne
Dim LastRow As Long
Dim tmp
Dim Numligne(256) As Long
Dim marchehaute As Integer
Dim marchebasse As Integer
Dim marche As Integer

wks.Cells(1, 1).Select

LastRow = 0
LigCol1 = 1
While wks.Cells(LigCol1, 1) < ""
LastRow = LastRow + 1
LigCol1 = LigCol1 + 1
Wend

LigCol1 = 1
wks.Cells(LigCol1, 1).Select
While LigCol1 <= LastRow '''MAIN LOOP
Numligne(LigCol1) = wks.Cells(LigCol1, 1)
'MsgBox wks.Cells(LigCol1, 1)
For LigCol2 = 1 To LastRow

If Numligne(LigCol1) = wks.Cells(LigCol2, 2) Then '2a-IF7

If LigCol2 < LigCol1 Then '3a-IF9
Cells(LigCol2, 2).Select
marchehaute = LigCol1 - LigCol2
marche = 1
While marche <= marchehaute
Selection.Insert shift:=xlDown
marche = marche + 1
Wend

ElseIf LigCol2 LigCol1 Then
Cells(LigCol1, 1).Select
marchebasse = LigCol2 - LigCol1
marche = 1
While marche <= marchebasse
Selection.Insert shift:=xlDown
marche = marche + 1
LastRow = LastRow + 1
Wend

End If '3a-IF9

End If '2a-IF7

Next LigCol2

LigCol1 = LigCol1 + 1

Wend '''END OF MAIN LOOP

''' SECONDARY LOOP

LigCol1 = 1
wks.Cells(LigCol1, 1).Select
For LigCol1 = 1 To LastRow
'MsgBox wks.Cells(LigCol1, 1) & " - " & wks.Cells(LigCol1, 2)

If Not IsEmpty(wks.Cells(LigCol1, 1)) Then '2b-IF5
If Not IsEmpty(wks.Cells(LigCol1, 2))
Then 'A
If wks.Cells(LigCol1, 1).Value < wks.Cells(LigCol1, 2).Value
Then
Cells(LigCol1, 1).EntireRow.Insert shift:=xlDown
Cells(LigCol1 + 1, 1).Select
Selection.Cut
Cells(LigCol1, 1).Select
ActiveSheet.Paste
LastRow = LastRow + 1
End If
End If
End If '2b-IF5
'Range("B9").EntireRow.Insert shift:=xlDown
Next LigCol1

''' END OF SECONDARY LOOP

'MsgBox LastRow

End Sub


-°-
thanks
  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 203
Default Align cells with same value - vba almost working

cm comments in-line

"bpascal123" wrote in message
...
Hi,

Thanks for your code.
I went through part of it not without difficulties. I should have told
first it's my first vba code from a personal task...and i'm not really
aware of vba objects that's why most code here is shorter than mine
and seems a lot more efficient. I'll try to read them further.
However, i find it easier to learn vba code while implementing a
personal task rather than from reading lines of code. Any further
advice for this feeling?

cmI saw several different solutions proposed, each using a slightly
different approach. My advice would be to invest the time to understand
exactly how and why each proposal works. Rather than "reading lines of
code", paste them into a code module and use a combination of the
debugger and <F1 (the built-in help) to discover that understanding. I
found that when I began using the debugger's Locals Window my level of
understanding of vba objects increased dramatically. [VBE Menu: View |
Locals Window ]

From what I can understand, I should use less the select method and
use more the offset property.

cm It's not so much using offset instead of select that gains
efficiency. As I understand it, you gain the most efficiency when you
write code that does not update the display- .Select and .Activate do
update the display. In code you can read or modify a range directly
without ever selecting it. I was going to suggest that you read the
entire range into an array, manipulate the array within vba, then write
the updated array back to the worksheet as a method to increase
efficiency (only "touch" the worksheet 6 or 7 times total, rather than
"touching" it for each cell as you iterate through the data) -- but
never did because that has already been posted. So: the efficiency gains
come from reducing manipulation of the display (and, I think, from
reducing the number of "touches" on the worksheet.)

It would quite change the design of the
code and programming habits (I have a 2-3 years programming experience
with non-object languages). Would learning C++ help to find vba
easier?

cm I cannot speak to that; I have no C experinece at all.

So, I have found a fix on the secondary loop that makes the code work,
see 'A
However, I don't know if it's as rock solid as what I can find from
average and experts codes. Whatsoever, i know it's not efficient. I
understand I should get some training with vba arrays and the job done
in vba array.

Are vba arrays treated in segment data or heap or stack memory. Are
variant and fixed size arrays treated the same?

cm I suggest that you read the help regarding arrays. It may help
answer your question. A variable of type variant can hold an array --
and that is different from an array variable delared with a Dim
ArrayName() statement. My suggestion was going to use three arrays -
one fixed array each for your column 1 and column 2 data, and a variable
two dimensional array that "grew" (using ReDim) each iteration. What I
don't know is the efficiency cost of using redim to extend an array each
iteration (vs) using a fixed array. The trouble with using a fixed
array in this case is that you do not know in advance how many rows will
be required in the final result.

[ snip ]

cm A couple comments regarding your original code:

I noticed that in some places you used [ wks.cells(...) ] and in other
placed you left off the wks qualifier [ cells(...) ]. Dangerous
practice -- in fact, I noticed it when I (inadvertantly) created a test
environment where the default worksheet object (the one referenced by
Cells without the preceeding object qualifier) was different by the time
the [ Cells(...) ] was executed than when [Set wks = Activesheet ] was
executed which caused erroneous results.

Also, as a matter of personal preference, I much prefer using
debug.print than msgbox while testing code. [ View | Immediate Window ]
to see what debug.print has printed. In fact, I use a combination of
debug.print, setting breakpoints, single-stepping through code, Locals
Window and the screen-tip of variable contents when hovering over a
variable while execution is stopped during a breakpoint.

Welcome to learning VBA! You have come to an excellent place to ask
questions and receive good answers. Come back often just to lurk ---
you will learn much from the solutions and answers posted here.

--
Clif McIrvin

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


  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,934
Default Align cells with same value - vba almost working

*** DO NOT USE THE CODE I POST PREVIOUSLY ***

DAMN! The code I posted does not always work correctly.

I'm working on alternative code new.

Rick Rothstein (MVP - Excel)


  #11   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,934
Default Align cells with same value - vba almost working

Not as compact as I still imagine is possible, but here is working code
(until I can find a more compact version)...

Sub AlignColumnData()
Dim X As Long, Lngth As Long, Data As Variant, Cell As Range
Data = WorksheetFunction.Transpose(Range("B1:B" & Cells(Rows.Count,
"B").End(xlUp).Row))
With Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)
.Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Clear
End With
Columns("A").Sort Range("A1"), xlAscending
For X = 2 To Cells(Rows.Count, "A").End(xlUp).Row
With Cells(X, "A")
If .Value = Cells(X - 1, "A").Value Then
.Offset(-1, 1).Value = Cells(X, "A").Value
.Clear
End If
End With
Next
Columns("A").SpecialCells(xlCellTypeBlanks).Entire Row.Delete
For X = LBound(Data) To UBound(Data)
With Columns("A").Find(Data(X), LookAt:=xlWhole)
Lngth = Len(.Offset(0, 1).Value)
If Lngth = 0 Then
.Copy .Offset(0, 1)
.Clear
End If
End With
Next
End Sub

Rick Rothstein (MVP - Excel)

  #12   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 203
Default Align cells with same value - vba almost working

Rick - I'm studying your code with interest -- and have a couple "Why"
questions.

"Rick Rothstein" wrote in message
...
Not as compact as I still imagine is possible, but here is working
code (until I can find a more compact version)...

Sub AlignColumnData()
Dim X As Long, Lngth As Long, Data As Variant, Cell As Range
Data = WorksheetFunction.Transpose(Range("B1:B" & Cells(Rows.Count,
"B").End(xlUp).Row))
With Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)


Here you repeated [ Cells(Rows.Count, "B").End(xlUp).Row) ] on two
lines.

Is that actually faster than putting the result into a Long varaible?

[...]
Lngth = Len(.Offset(0, 1).Value)
If Lngth = 0 Then


and here, you use the long variable, but I'm mystified as to why.
Wouldn't it work to put the [ Len(.Offset(0, 1).Value) ] directly in the
If statement?

Perhaps you have a link to direct me to additional reading?


--
Clif McIrvin

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


  #13   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,934
Default Align cells with same value - vba almost working

Rick - I'm studying your code with interest -- and have a
couple "Why" questions.


I will be away from my computer for awhile, but feel free to ask away and
I'll be happy to respond when I return.

Rick Rothstein (MVP - Excel)




"Clif McIrvin" wrote in message
...

Rick - I'm studying your code with interest -- and have a couple "Why"
questions.

"Rick Rothstein" wrote in message
...
Not as compact as I still imagine is possible, but here is working code
(until I can find a more compact version)...

Sub AlignColumnData()
Dim X As Long, Lngth As Long, Data As Variant, Cell As Range
Data = WorksheetFunction.Transpose(Range("B1:B" & Cells(Rows.Count,
"B").End(xlUp).Row))
With Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)


Here you repeated [ Cells(Rows.Count, "B").End(xlUp).Row) ] on two
lines.

Is that actually faster than putting the result into a Long varaible?

[...]
Lngth = Len(.Offset(0, 1).Value)
If Lngth = 0 Then


and here, you use the long variable, but I'm mystified as to why.
Wouldn't it work to put the [ Len(.Offset(0, 1).Value) ] directly in the
If statement?

Perhaps you have a link to direct me to additional reading?


--
Clif McIrvin

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

  #14   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 203
Default Align cells with same value - vba almost working

"Rick Rothstein" wrote in message
...
Rick - I'm studying your code with interest -- and have a
couple "Why" questions.


I will be away from my computer for awhile, but feel free to ask away
and I'll be happy to respond when I return.

Rick Rothstein (MVP - Excel)


No problem - I appreciate the tutelage!

Perhaps I should have clarified that my questions were "in-line" below:




"Clif McIrvin" wrote in message
...

Rick - I'm studying your code with interest -- and have a couple "Why"
questions.

"Rick Rothstein" wrote in
message
...
Not as compact as I still imagine is possible, but here is working
code (until I can find a more compact version)...

Sub AlignColumnData()
Dim X As Long, Lngth As Long, Data As Variant, Cell As Range
Data = WorksheetFunction.Transpose(Range("B1:B" & Cells(Rows.Count,
"B").End(xlUp).Row))
With Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)


Here you repeated [ Cells(Rows.Count, "B").End(xlUp).Row) ] on two
lines.

Is that actually faster than putting the result into a Long varaible?

[...]
Lngth = Len(.Offset(0, 1).Value)
If Lngth = 0 Then


and here, you use the long variable, but I'm mystified as to why.
Wouldn't it work to put the [ Len(.Offset(0, 1).Value) ] directly in
the
If statement?

Perhaps you have a link to direct me to additional reading?


--
Clif McIrvin

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




--
Clif McIrvin

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


  #15   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,934
Default Align cells with same value - vba almost working

Perhaps I should have clarified that my questions were "in-line" below:

Sorry, I didn't think to scroll down. Yes, both of your questions were valid
observations... 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. Here is the cleaned up code (which I'll
also post separately against my previous message that posted the original
code)...

Sub AlignColumnData()
Dim X As Long, Data As Variant, Cell As Range
With Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)
Data = WorksheetFunction.Transpose(.Cells)
.Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Clear
End With
Columns("A").Sort Range("A1"), xlAscending
For X = 2 To Cells(Rows.Count, "A").End(xlUp).Row
With Cells(X, "A")
If .Value = Cells(X - 1, "A").Value Then
.Offset(-1, 1).Value = Cells(X, "A").Value
.Clear
End If
End With
Next
Columns("A").SpecialCells(xlCellTypeBlanks).Entire Row.Delete
For X = LBound(Data) To UBound(Data)
With Columns("A").Find(Data(X), LookAt:=xlWhole)
If Len(.Offset(0, 1).Value) = 0 Then
.Copy .Offset(0, 1)
.Clear
End If
End With
Next
End Sub

Rick Rothstein (MVP - Excel)



  #16   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,934
Default Align cells with same value - vba almost working

Here is cleaned up code that resulted from two excellent observations by
Clif McIrvin (thanks Clif)....

Sub AlignColumnData()
Dim X As Long, Data As Variant, Cell As Range
With Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)
Data = WorksheetFunction.Transpose(.Cells)
.Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Clear
End With
Columns("A").Sort Range("A1"), xlAscending
For X = 2 To Cells(Rows.Count, "A").End(xlUp).Row
With Cells(X, "A")
If .Value = Cells(X - 1, "A").Value Then
.Offset(-1, 1).Value = Cells(X, "A").Value
.Clear
End If
End With
Next
Columns("A").SpecialCells(xlCellTypeBlanks).Entire Row.Delete
For X = LBound(Data) To UBound(Data)
With Columns("A").Find(Data(X), LookAt:=xlWhole)
If Len(.Offset(0, 1).Value) = 0 Then
.Copy .Offset(0, 1)
.Clear
End If
End With
Next
End Sub

Rick Rothstein (MVP - Excel)

  #17   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 203
Default Align cells with same value - vba almost working

"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.

--
Clif McIrvin

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



  #18   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default Align cells with same value - vba almost working

Really nice, Rick! You continue to shine...

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc


  #19   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,934
Default Align cells with same value - via almost working

Really nice, Rick!

Thanks, but I still think there is a simpler underlying algorithm available
to solve this problem... I'll be looking again at this problem a little bit
later.

Rick Rothstein (MVP - Excel)

  #20   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,934
Default Align cells with same value - vba almost working

**NOTE: This is a repost... I thought I would try again. I replied to your
message with this same response earlier, but my newsreader is not showing it
inside this thread, rather, it shows it as a response (it contains the ""
in the subject, but it is located in the message tree as if it were starting
a new thread.

Really nice, Rick!


Thanks, but I still think there is a simpler underlying algorithm available
to solve this problem... I'll be looking again at this problem a little bit
later.

Rick Rothstein (MVP - Excel)



  #21   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 33
Default Align cells with same value - vba almost working

On Mar 12, 11:58*pm, bpascal123 wrote:
Hi cyberspace,

I have spent quite some time trying to make this work but at this
point from *adding many msgbox checks, using the watch window for
variables values everything seems coherent *to me.

I have 2 columns with sorted identical and not identical numercial
values in both columns :

col.A * * * col.B
251120 *251130
251140 *272505
251145 *291101
272505 *292100
272535
291130
292100

I need to align identical value and to place single value alone on
one
row just like below :

251120
* * * * * * * * 251130
251140
251145
272505 *272505
272535
* * * * * * * * 291101
291130
292100 *292100

Now with the vba code, I get this :

Option Explicit
Option Base 1

Public Sub RowMatching()

* Dim wkb As Workbook
* Dim wks As Worksheet
* Set wkb = Workbooks("code_row_v2.xls")
* Set wks = wkb.Worksheets("Sheet1")
* Dim trouve As Boolean
* Dim LigCol1 As Integer *'numéro de ligne pour la premiere colonne
* Dim LigCol2 As Integer *'numéro de ligne pour la seconde colonne
* Dim LastRow As Long
* Dim tmp
* Dim Numligne(256) As Long
* Dim marchehaute As Integer
* Dim marchebasse As Integer
* Dim marche As Integer

* wks.Cells(1, 1).Select
* LastRow = 0
* LigCol1 = 1
* While wks.Cells(LigCol1, 1) < ""
* * LastRow = LastRow + 1
* * LigCol1 = LigCol1 + 1
* Wend
* LigCol1 = 1
* wks.Cells(LigCol1, 1).Select

* While LigCol1 <= LastRow *'''MAIN LOOP

* * Numligne(LigCol1) = wks.Cells(LigCol1, 1)
* * 'MsgBox wks.Cells(LigCol1, 1)

* * For LigCol2 = 1 To LastRow
* * * If Numligne(LigCol1) = wks.Cells(LigCol2, 2) Then '2a-IF7
* * * * If LigCol2 < LigCol1 Then * * * * * * * * * * * '3a-IF9
* * * * * Cells(LigCol2, 2).Select
* * * * * marchehaute = LigCol1 - LigCol2
* * * * * marche = 1
* * * * * While marche <= marchehaute
* * * * * * Selection.Insert shift:=xlDown
* * * * * * marche = marche + 1
* * * * * Wend
* * * * ElseIf LigCol2 LigCol1 Then
* * * * * Cells(LigCol1, 1).Select
* * * * * marchebasse = LigCol2 - LigCol1
* * * * * marche = 1
* * * * * While marche <= marchebasse
* * * * * * Selection.Insert shift:=xlDown
* * * * * * marche = marche + 1
* * * * * * LastRow = LastRow + 1
* * * * * Wend
* * * * End If * * * * * * * * * * * * * * * * * * * * *'3a-IF9
* * * End If * * * * * * * * * * * * * * * * * * * * * *'2a-IF7
* * Next LigCol2
* * LigCol1 = LigCol1 + 1

* Wend '''END MAIN LOOP

* LigCol1 = 1
* wks.Cells(LigCol1, 1).Select

''SECONDARY LOOP TO INSERT ROW FOR REMAINING NON IDENTICAL VALUES
FOUND ONTO SAME ROWS

* For LigCol1 = 1 To LastRow '

* * MsgBox wks.Cells(LigCol1, 1) & " - " & wks.Cells(LigCol1, 2)
* * If Not IsEmpty(wks.Cells(LigCol1)) Then
* * * If wks.Cells(LigCol1, 1).Value < wks.Cells(LigCol1, 2).Value
Then
* * * * Rows(LigCol1).Select
* * * * Selection.Insert shift:=xlDown
* * * * Cells(LigCol1 + 1, 1).Select
* * * * Selection.Cut
* * * * Cells(LigCol1, 1).Select
* * * * ActiveSheet.Paste
* * * * LastRow = LastRow + 1
* * * End If
* * End If * * * * * * * * * * * * * * * * * * * * * * * * * '2b-IF5

* Next LigCol1 * '''END SECONDARY LOOP

* MsgBox LastRow

End Sub

Variable names are in french but it's easy : consider marche is
floor : marchebasse = lowerfloor, marchehaute = upperfloor... in fact
marche means step but steps has many meaning in english and is a vba
keyword as well..., here it would
be stairway.

Ok, this is what I get when i run the code from above :

251120
* * * * * * * * 251130
251140
251145
272505 *272505
272535 *291101
291130
292100 *292100

Although, the switch is completed for values 251120 and 251130
initialy on the same row, they are now on 2 distinct rows as stated
in *For LigCol1 = 1 To LastRow loop .

But when it comes to values 272535 and 291101, no new rows is added
as
it should for two different values on the same row. msgbox even show
the loop is going though these values as with 251120 and 251130
Could you point where I am missing something?

I would very much appreciate to understand why it's not working as
intended as it seems coherent from the msgbox checks when running it.
I think something is messing in the secondary loop block code.

Thanks,
Cyberuser


From Phillip London UK

This works for me

Sub DoData()
Dim vRng1, vRng2, vEvaluate As Variant
Dim NoMa As Long
Dim Ma As Long
Dim TempRng As Range

vRng1 = Sheet1.Range("A1:A7").Value 'change range as required
vRng2 = Sheet1.Range("B1:B4").Value ''change range as required
Range("B:B").Clear

For z = LBound(vRng2) To UBound(vRng2)
vEvaluate = Application.Evaluate("IF(ISNA(MATCH(" & CLng(vRng2(z,
1))& ",A:A,0)),1,0)")
If vEvaluate = 1 Then
NoMa = Application.Evaluate("Match(" & CLng(vRng2(z, 1)) &
",A:A,1)")
Set TempRng = Range("A1").Offset(NoMa, 0)
TempRng.EntireRow.Insert
TempRng.Offset(-1, 1).Value = CLng(vRng2(z, 1))
Else
Ma = Application.Evaluate("MATCH(" & CLng(vRng2(z, 1)) &
",A:A,0)")
Range("B1").Offset(Ma - 1, 0).Value = CLng(vRng2(z, 1))
End If
Next
End Sub



  #22   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default Align cells with same value - via almost working

Rick Rothstein used his keyboard to write :
Really nice, Rick!


Thanks, but I still think there is a simpler underlying algorithm available
to solve this problem... I'll be looking again at this problem a little bit
later.

Rick Rothstein (MVP - Excel)


I'm interested to see what you come up with.

My offering was spawned by the feeling the the OP's approach was just
way more complicated than need be. I chose a rather simple, straight
forward approach that also was reasonably self-documenting (IMO).

The problem I see with our preferred approach of code brevity is that
it requires more comments so we don't have to 'study' the code to
remember what it's doing later on. Not a problem really because
so-called self-documented code may also require additional comments to
be properly understood.

Now (as you know) I like the brevity, though it's not often the best
approach for helping the OP.

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc


  #23   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5
Default Align cells with same value - vba almost working

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

Thx
Pascal
  #24   Report Post  
Posted to microsoft.public.excel.programming
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 :-)


  #25   Report Post  
Posted to microsoft.public.excel.programming
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 :-)




  #26   Report Post  
Posted to microsoft.public.excel.programming
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


  #27   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default Align cells with same value - vba almost working

Rick Rothstein submitted this idea :
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,
With this set of data, your revised version errors out on the line...

Columns("A").SpecialCells(xlCellTypeBlanks).Entire Row.Delete

...and so works if we wrap this in On Error Resume Next and On Error
GoTo 0 statements.

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc


  #28   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 203
Default Align cells with same value - vba almost working

"GS" wrote in message
...
Rick Rothstein submitted this idea :
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,
With this set of data, your revised version errors out on the line...

Columns("A").SpecialCells(xlCellTypeBlanks).Entire Row.Delete

..and so works if we wrap this in On Error Resume Next and On Error
GoTo 0 statements.



??? Rick's revised version as posted works just fine over here.

--
Clif McIrvin

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


  #29   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 203
Default Align cells with same value - vba almost working

"Rick Rothstein" wrote in message
...
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



Thanks, Rick. I realized that after I'd turned the computer off and
gone home yesterday. In fact, the code I posted only works if both
columns have the same final value.

Staying with the attempt to do all the work inside VBA (I still don't
know if that's a good idea or a bad idea --- I suppose that might depend
on what else is involved. I have read more than once that using
worksheet functions is generally considerably faster than doing the same
thing in VBA.) here's a re-work that I believe handles all cases - I
tested three combinations of last value, also tested with string data
instead of numbers.

Sub AlignData2()
'cm 3/19/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

LastColAin = Cells(Rows.Count, 1).End(xlUp).Row
LastColBin = Cells(Rows.Count, 2).End(xlUp).Row
With WorksheetFunction
ColAin = .Transpose(Range(Cells(1, 1), Cells(LastColAin, 1)))
ColBin = .Transpose(Range(Cells(1, 2), Cells(LastColBin, 2)))
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

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

If idxColAin LastColAin Then
ThisColAin = Empty
Else
ThisColAin = ColAin(idxColAin)
End If

If idxColBin LastColBin Then
ThisColBin = Empty
Else
ThisColBin = ColBin(idxColBin)
End If

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


  #30   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default Align cells with same value - vba almost working

Clif McIrvin laid this down on his screen :
"GS" wrote in message
...
Rick Rothstein submitted this idea :
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,
With this set of data, your revised version errors out on the line...

Columns("A").SpecialCells(xlCellTypeBlanks).Entire Row.Delete

..and so works if we wrap this in On Error Resume Next and On Error GoTo 0
statements.



??? Rick's revised version as posted works just fine over here.


Did you test using his suggested (non-dupe) data set above?

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc




  #31   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default Align cells with same value - vba almost working

GS formulated the question :
Clif McIrvin laid this down on his screen :
"GS" wrote in message
...
Rick Rothstein submitted this idea :
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,
With this set of data, your revised version errors out on the line...

Columns("A").SpecialCells(xlCellTypeBlanks).Entire Row.Delete

..and so works if we wrap this in On Error Resume Next and On Error GoTo 0
statements.



??? Rick's revised version as posted works just fine over here.


Did you test using his suggested (non-dupe) data set above?


Well I'll be..! Today it works just fine!

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc


  #32   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default Align cells with same value - vba almost working

GS wrote :
Rick Rothstein submitted this idea :
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,
With this set of data, your revised version errors out on the line...

Columns("A").SpecialCells(xlCellTypeBlanks).Entire Row.Delete

..and so works if we wrap this in On Error Resume Next and On Error GoTo 0
statements.


Seems to work fine today! Can't repeat condition I got the error..!

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc


  #33   Report Post  
Posted to microsoft.public.excel.programming
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 :-)


  #34   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 203
Default Align cells with same value - vba almost working

"GS" wrote in message
...
GS formulated the question :
Clif McIrvin laid this down on his screen :
"GS" wrote in message
...
Rick Rothstein submitted this idea :
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,
With this set of data, your revised version errors out on the
line...

Columns("A").SpecialCells(xlCellTypeBlanks).Entire Row.Delete

..and so works if we wrap this in On Error Resume Next and On Error
GoTo 0 statements.



??? Rick's revised version as posted works just fine over here.


Did you test using his suggested (non-dupe) data set above?


Well I'll be..! Today it works just fine!



The plot thickens.

Today I am receiving the error you describe with non-repeating data.

--
Clif McIrvin

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


  #35   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default Align cells with same value - vba almost working

Clif McIrvin laid this down on his screen :
"GS" wrote in message
...
GS formulated the question :
Clif McIrvin laid this down on his screen :
"GS" wrote in message
...
Rick Rothstein submitted this idea :
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,
With this set of data, your revised version errors out on the line...

Columns("A").SpecialCells(xlCellTypeBlanks).Entire Row.Delete

..and so works if we wrap this in On Error Resume Next and On Error GoTo
0 statements.



??? Rick's revised version as posted works just fine over here.

Did you test using his suggested (non-dupe) data set above?


Well I'll be..! Today it works just fine!



The plot thickens.

Today I am receiving the error you describe with non-repeating data.


Geez.., does this mean we have a virus?<bg ;-)

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc




  #36   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 203
Default Align cells with same value - via almost working

"Rick Rothstein" wrote in message
...
Really nice, Rick!


Thanks, but I still think there is a simpler underlying algorithm
available to solve this problem... I'll be looking again at this
problem a little bit later.



After getting my code working correctly, I still had one pesky question
rattling about inside my skull that just wouldn't go away:

Was there any really significant difference between my approach of doing
all the work "inside VBA" using arrays as contrasted with Rick's
approach of using worksheet methods?

That question bothered me enough I put together a little test to check
execution time. In the process, when I developed a random data generator
that resulted in sample data that contained *no* repeating values I
encountered the same error in Rick's code that GS reported - so I
implemented his solution of On Error Resume Next ... On Error Goto 0.
Likewise, my routine errored out when the array indices exceeded the
upper bound of the array. There, I had the choice of adding code to
place an upper limit on the array indices, or using "Resume Next". I
chose the latter.

Also, I discovered that execution time was fast enough that using the
Time function was useless ... so I borrowed a timeGetTime declared
function that I noticed Wouter post in a different thread recently.
Thanks, Wouter!

Results (looks better in notepad)
The second column is Rick's code, the third is mine:

Trial Elapsed time w/ range methods Elapsed time using arrays
1 27500 31
2 28703 31
3 30906 16
4 33016 31
5 34656 31
Average 30956 28

1200 values in Column A
800 values in Column B
Time in milliseconds
no duplicates (=rand())

After obtaining these results, I realized that my test data algorithm
was not producing any repeating values, so I added a ROUND function to
force duplicates and repeated the test:

Trial Elapsed time w/ range methods Elapsed time using arrays
1 7984 16
2 19531 16
3 25375 16
4 24984 16
5 25109 32
Average 20597 19

1200 values in Column A
800 values in Column B
Time in milliseconds
3 decmal places

The code I used follows. To repeat the test, paste all the following
code into a code module, and execute [ RunTest ].

The test parameters are all Constant declarations at the top of the
module; [ SetupTest ] contains some comment blocks that can be switched
around if you wish to keep copies of the test data worksheets so you can
see the data used in the trials.

As always, watch out for broken (wrapped) lines.

============== begin code ============

Option Explicit

Const TestRows As Long = 12
Const TestRows2 As Long = 8
Const NumberOfTrials As Long = 3
Const numDigits As Long = 3 ' number of places in random value

Declare Function timeGetTime Lib "winmm.dll" () As Long
'timeGetTime thanks to Wouter

Sub RunTest()

Dim elapsedTime(1 To 2) As Long
Dim startTime As Long
Dim stopTime As Long
Dim resultsRow As Long
Dim trialNumber As Long

Dim Results As Worksheet
Dim Test1 As Worksheet
Dim Test2 As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual

Set Results = SetupResults
resultsRow = 2

With Sheets
Set Test1 = .Add(After:=Sheets(.Count))
Set Test2 = .Add(After:=Sheets(.Count))
End With

For trialNumber = 1 To NumberOfTrials
SetupTest Test1, Test2, trialNumber

Test1.Activate
startTime = timeGetTime
AlignColumnData
stopTime = timeGetTime
elapsedTime(1) = (stopTime - startTime)

Test2.Activate
startTime = timeGetTime
AlignData
stopTime = timeGetTime
elapsedTime(2) = (stopTime - startTime)

With Results.Rows(resultsRow)
.Cells(1) = trialNumber
.Cells(2) = elapsedTime(1)
.Cells(3) = elapsedTime(2)
End With
resultsRow = resultsRow + 1

Next trialNumber

With Results.Rows(resultsRow)
.Cells(1) = "Average"
.Cells(2) = "=AVERAGE(B2:B" & .Row - 1 & ")"
.Cells(2).AutoFill Destination:= _
Range(.Cells(2), .Cells(3)), Type:=xlFillDefault
End With

With Results
.Cells(resultsRow + 2, 2) = TestRows & " values in Column A"
.Cells(resultsRow + 3, 2) = TestRows2 & " values in Column B"
.Cells(resultsRow + 4, 2) = "Time in milliseconds"
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlAutomatic
Results.Activate

End Sub

Function SetupResults() As Worksheet

Set SetupResults = Sheets.Add(After:=Sheets(Sheets.Count))
With SetupResults
.Cells(1).Formula = "Trial"
.Cells(2).Formula = "Elapsed time w/ range methods"
.Cells(3).Formula = "Elapsed time using arrays"
With .Columns("B:C")
.ColumnWidth = 15.43
'.NumberFormat = "0.00000"
.NumberFormat = "0"
.HorizontalAlignment = xlCenter
End With
With .Range("B1:C1")
.WrapText = True
End With
.Columns("A:A").HorizontalAlignment = xlCenter
.Name = "Results"
End With
End Function

Sub SetupTest(ByRef Test1 As Worksheet, _
ByRef Test2 As Worksheet, _
trialNumber As Long)

'''''''''''''''''''''''''''''''''''
' keep each trial worksheet
'Set Test1 = Sheets.Add(After:=Sheets(Sheets.Count))
'''''''''''''''''''''''''''''''''''

With Test1
.Cells(1).CurrentRegion.Clear
.Name = "Trial" & trialNumber
.Range(.Cells(1), .Cells(TestRows, 2)).Formula = _
"=ROUND(RAND()," & numDigits & ")"
.Calculate
With .Cells(1).CurrentRegion
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
.Range(.Cells(TestRows2 + 1, 2), .Cells(TestRows, 2)).Clear
.Columns(1).Sort .Cells(1, 1), xlAscending
.Columns(2).Sort .Cells(1, 2), xlAscending

'''''''''''''''''''''''''''''''''''
' keep each trial worksheet
' .Copy After:=Sheets(.Index)
' Set Test2 = Sheets(.Index + 1)
'''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''
' keep sheets of final trial only
Test2.Cells(1).CurrentRegion.Clear
.Cells(1).CurrentRegion.Copy _
Destination:=Test2.Cells(1)
'''''''''''''''''''''''''''''''''''

End With
End Sub

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

On Error Resume Next
ThisColAin = ColAin(idxColAin)
ThisColBin = ColBin(idxColBin)
On Error GoTo 0

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


Sub AlignColumnData()
' Rick Rothstein Mon, 14 Mar 2011 20:21:08 -0400 [7:21 pm]
'Newsgroups: microsoft.public.Excel.programming
'Subject: Align cells with same value - vba almost working
'Date: Tue, 15 Mar 2011 10:06:04 -0400 [9:06 am]
'comments added by cm
Dim X As Long, Data As Variant, Cell As Range
With Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)
Data = WorksheetFunction.Transpose(.Cells)
.Copy Cells(Rows.Count, "A").End(xlUp).Offset(1) ' copy "B" below
"A"
.Clear
End With
Columns("A").Sort Range("A1"), xlAscending
For X = 2 To Cells(Rows.Count, "A").End(xlUp).Row ' move dupes aligned
to col B
With Cells(X, "A")
If .Value = Cells(X - 1, "A").Value Then
.Offset(-1, 1).Value = Cells(X, "A").Value
.Clear
End If
End With
Next
On Error Resume Next
Columns("A").SpecialCells(xlCellTypeBlanks).Entire Row.Delete ' remove
empty rows
On Error GoTo 0
For X = LBound(Data) To UBound(Data) ' move unmatched B data aligned
to col B
With Columns("A").Find(Data(X), LookAt:=xlWhole)
' if B not empty then found value was (and now is aligned) in both
A and B
' if B is empty this found value was in B not in A so move it back
to B
If Len(.Offset(0, 1).Value) = 0 Then
.Copy .Offset(0, 1)
.Clear
End If
End With
Next
End Sub


--
Clif McIrvin

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


  #37   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 203
Default Align cells with same value - via almost working

"Clif McIrvin" wrote in message
...
"Rick Rothstein" wrote in
message ...
Really nice, Rick!


Thanks, but I still think there is a simpler underlying algorithm
available to solve this problem... I'll be looking again at this
problem a little bit later.



After getting my code working correctly, I still had one pesky
question rattling about inside my skull that just wouldn't go away:

Was there any really significant difference between my approach of
doing all the work "inside VBA" using arrays as contrasted with Rick's
approach of using worksheet methods?

That question bothered me enough I put together a little test to check
execution time.


[ ]

I forgot to add that if anyone wishes to compare any of the other
solutions posted in this thread I constrtucted my [ RunTest ], [
SetupResults ] and [ SetupTest ] procedures so that additional
procedures can be added without too much trouble (I hope! <g ).

--
Clif McIrvin

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


  #38   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 203
Default Align cells with same value - vba almost working

"GS" wrote in message
...
[ ]
??? Rick's revised version as posted works just fine over here.

Did you test using his suggested (non-dupe) data set above?

Well I'll be..! Today it works just fine!



The plot thickens.

Today I am receiving the error you describe with non-repeating data.


Geez.., does this mean we have a virus?<bg ;-)



I did some more testing ... I thought I'd run it against his posted
sample data, but now it fails every time.

(btw; did you happen to see the execution time comparison I posted
elsewhere in this thread?)

--
Clif McIrvin

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


  #39   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default Align cells with same value - vba almost working

Clif McIrvin brought next idea :
"GS" wrote in message
...
[ ]
??? Rick's revised version as posted works just fine over here.

Did you test using his suggested (non-dupe) data set above?

Well I'll be..! Today it works just fine!



The plot thickens.

Today I am receiving the error you describe with non-repeating data.


Geez.., does this mean we have a virus?<bg ;-)



I did some more testing ... I thought I'd run it against his posted sample
data, but now it fails every time.


I added a line to sort colB before loading it into the array so both
cols of data were sorted. I think the error comes with having empty
cells included in the array, but I wouldn't think that should matter
since the loop would just skip over those elements, -right?


(btw; did you happen to see the execution time comparison I posted elsewhere
in this thread?)


Yes, I saw the execution times you posted. Impressive! Not sure whether
I'm interested in testdriving it though. Just can't imagine having that
much data to process in a spreadsheet. Not saying it's not gonna
happen, just not typical of the type of work I do for clients. A MDB
and data controls is a better approach <IMO for large amounts of data.
Even when the data store is a plain text file, it's easier to use data
controls than read/write cells. <..again, IMO

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc


  #40   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 203
Default Align cells with same value - vba almost working

[ reply inline ]

"GS" wrote in message
...
Clif McIrvin brought next idea :
"GS" wrote in message
...
[ ]
??? Rick's revised version as posted works just fine over here.

Did you test using his suggested (non-dupe) data set above?

Well I'll be..! Today it works just fine!



The plot thickens.

Today I am receiving the error you describe with non-repeating
data.

Geez.., does this mean we have a virus?<bg ;-)



I did some more testing ... I thought I'd run it against his posted
sample data, but now it fails every time.


I added a line to sort colB before loading it into the array so both
cols of data were sorted. I think the error comes with having empty
cells included in the array, but I wouldn't think that should matter
since the loop would just skip over those elements, -right?


In Rick's code, he copies Col B below A, then sorts ... and uses the
..Find method to ID the Col B values ... so there is no advantage to
pre-sorting Col B. As near as I could tell, the error is due to the
fact that there are *no* empty cells (ie, no duplicated values) after
his first loop.

After some thought, I replaced your suggested ' Resume Next ' with a
boolean flag -- that seemed to me to introduce less execution overhead,
but I really don't know. I added one line below the .Clear in the first
loop, then wrapped the line that errors in an IF:

Dim movedDuplicateValues As Boolean
....
movedDuplicateValues = True
....
If movedDuplicateValues Then
Columns("A").SpecialCells(xlCellTypeBlanks).Entire Row.Delete '
remove empty rows
End If


As to the error in my code, it was due to faulty logic in my testing for
end of data. I was already adding an empty cell to the end of my array
to handle running past the end of data, but my attempt at working
regardless of which column had more values wasn't all the way home. I
ended up revising my IF ... ELSEIF construct (reposted below):



(btw; did you happen to see the execution time comparison I posted
elsewhere in this thread?)


Yes, I saw the execution times you posted. Impressive! Not sure
whether I'm interested in testdriving it though. Just can't imagine
having that much data to process in a spreadsheet. Not saying it's not
gonna happen, just not typical of the type of work I do for clients. A
MDB and data controls is a better approach <IMO for large amounts of
data. Even when the data store is a plain text file, it's easier to
use data controls than read/write cells. <..again, IMO


I agree on both points. I guess I was just too curious what the
difference was to leave it alone! <g

Clif

(code snippet)

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 Not IsEmpty(ThisColAin) And IsEmpty(ThisColBin) Then
' Copy ColA, ColB = Empty
Out(1, LastOut) = ThisColAin
idxColAin = idxColAin + 1
ElseIf Not IsEmpty(ThisColBin) And IsEmpty(ThisColAin) Then
' Copy ColB, ColA = Empty
Out(2, LastOut) = ThisColBin
idxColBin = idxColBin + 1
ElseIf ThisColBin ThisColAin Then
' ColB is Larger: Copy ColA, ColB = Empty
Out(1, LastOut) = ThisColAin
idxColAin = idxColAin + 1
ElseIf 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)


--
Clif McIrvin

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


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How do I align numbers in different cells when some are in bracke. Doogie Excel Discussion (Misc queries) 2 May 17th 10 03:07 PM
ALIGN DATA CELLS? FARAZ QURESHI Excel Discussion (Misc queries) 14 December 22nd 08 04:11 PM
Align matching cells of two different columns John Desselle Excel Worksheet Functions 2 October 22nd 08 08:57 PM
how to align vertical cells horizontally Trice New Users to Excel 1 October 12th 05 05:42 PM
How do I align cells in Excel onto one line? Mario Excel Worksheet Functions 2 March 18th 05 02:11 PM


All times are GMT +1. The time now is 12:22 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"