Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How do I align numbers in different cells when some are in bracke. | Excel Discussion (Misc queries) | |||
ALIGN DATA CELLS? | Excel Discussion (Misc queries) | |||
Align matching cells of two different columns | Excel Worksheet Functions | |||
how to align vertical cells horizontally | New Users to Excel | |||
How do I align cells in Excel onto one line? | Excel Worksheet Functions |