Align cells with same value - vba almost working

[bpascal123]

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

 

[GS]

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

 

[joeu2004]

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

 

[joeu2004]

Errata....

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.

 

[Rick Rothstein]

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)

 

[Rick Rothstein]

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)

 

[Rick Rothstein]

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)

 

[bpascal123]

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

 

[Clif McIrvin]

cm> comments in-line

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?

cm>I 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.

 

[Rick Rothstein]

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

 

[Rick Rothstein]

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).EntireRow.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)

 

[Clif McIrvin]

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

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?

 

[Rick Rothstein]

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.

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]

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.

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?

 

[Rick Rothstein]

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).EntireRow.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)

 

[Rick Rothstein]

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).EntireRow.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)

 

[Clif McIrvin]

[...]... 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 re: comparison of the different
methods.

 

[GS]

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

 

[Rick Rothstein]

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)

 

[Rick Rothstein]

**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 "Re:"
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)