align columns of data with breaks in them

[madelca100]

I've seen several sample of code that aligns columns, but they all use 'unbroken' lists.

Currently this is done manually.
By cutting and pasteing L/M to a matched I value.
Insert a row where there is an L value and no I value. etc.
Very error prone.

Note: I can't copy this data, sort it, and paste it back in because I also matches values in columns C & F. All the alignment must take place on this worksheet.

My data is as follows:

The data starts in row 11 column I
There is other data in the spreadsheet.


I need to be able to align the values in I and L.

Note that there are gaps in column I.
Column L is sorted ascending with no gaps.

I need to be able to insert rows to match the values in col I and col L
(col L and the number in M need to move together)
and move down the values of L and M when they don't match I/J (the numbers in J and M may be different for the same value in I/L.

I hope somebody out there has solved this already.
mike


This is a small sample of the before date:
col I J L M
-------------------------
53 1 251 1
62 1 253 4
82 1 256 5
192 1 257 2
258 2
247 2 280 2
282 1
252 2 464 1
253 1 521 1
254 2 544 4
256 2 611 1
635 1
258 2 636 1
263 1 795 1
280 7


after:

col I J L M
-------------------
53 1
62 1
82 1
192 1

247 2
251 1
252 2
253 1 253 4
254 2
256 2 256 5
257 2
258 2 258 2
263 1
280 7 280 2
282 1
464 1
521 1
etc. etc.



Sample of code that doesn't work for this situation:

Sub AlignLists()
'
' Code by Cy Bones @ Neowin.net
'

Worksheets("sumrdata").Activate
Columns("a:a").Copy Destination:=Worksheets("Sheet2").Range("a1")

Range("a", Range("a").End(xlDown)).Copy _
Destination:=Worksheets("Sheet2").Range("A1").End(xlDown).Offset(1, 0)

Sheets("Sheet2").Activate
Range("A1", Range("A1").End(xlDown)).Sort Key1:=Range("A2"), _
Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom

Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("B1"), Unique:=True
Columns("A:A").Delete Shift:=xlToLeft

Worksheets("Sheet1").Range("A11").Copy _
Destination:=Worksheets("Sheet2").Range("B1")

Range("B2", Range("A2").End(xlDown).Offset(0, 2)).FormulaR1C1 = _
"=VLOOKUP(RC1,Sheet1!C1:C2,COLUMN()-1,FALSE)"

Range("D2", Range("C2").End(xlDown).Offset(0, 2)).FormulaR1C1 = _
"=VLOOKUP(RC1,Sheet1!C3:C4,COLUMN()-3,FALSE)"

With Range("A1").CurrentRegion
.Value = .Value
End With

Range("A1").CurrentRegion.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False

Columns("A:A").Delete Shift:=xlToLeft
Columns("A:E").EntireColumn.AutoFit

End Sub

 

[SkipVought]

madelca100,

You've been here at Tek-Tips for over FIVE years. Surely, you know about TGML Tags. Please look at your post and observe how difficult it is to understand 1) what columns of data line up in what column and 2) your VBA code.

If you do not know what TGML tags are, do a FIND on this page and then look for the TT tab and the CODE tag for starters.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SkipVought]

Give this a try...

Sub AlignLists()
'
    Dim r As Range, lOffset, wsA As Worksheet, wsB As Worksheet, i As Integer, j As Integer
    
    Set wsA = Worksheets("sumrdata")
    Set wsB = Worksheets("Sheet2")
    
    wsA.Columns("I:L").Copy Destination:=wsB.Range("A1")
    wsA.Columns("I:L").Clear
    
    wsB.Columns("A").Copy Destination:=wsB.Range("I1")
    wsB.Range(wsB.[C1], wsB.[C1].End(xlDown)).Copy _
            Destination:=wsB.Range("I65536").End(xlUp).Offset(1, 0)
            
    wsB.Columns("I").Sort _
        Key1:=wsB.Range("I1"), _
        Order1:=xlAscending, _
        Header:=xlNo, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom
        
    wsB.Columns("I").AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=wsB.Range("K1"), _
        Unique:=True
        
    For Each r In wsB.Range(wsB.[K1], wsB.[K1].End(xlDown))
        For i = 0 To 1
            lOffset = Application.Match(r.Value, wsB.Columns("A").Offset(0, i * 2), 0)
            If Not IsError(lOffset) Then
                For j = 0 To 1
                    wsA.Cells(r.Row, 9 + (i * 2) + j).Value = _
                        wsB.Cells(lOffset, 1 + (i * 2) + j).Value
                Next
            End If
        Next
    Next
    
    Set wsA = Nothing
    Set wsB = Nothing
End Sub

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[madelca100]

Thanks Skip for the code.

And thanks for pointing out TGML. Being here five years didn't magically clue me in to all the tips and techniques available on this site. I've only posted about two questions a year and offered about two dozen tips. (Not a frequent flier by any means.)

However I did see the difficulty reading the data examples, and I spent quite a bit of time trying to line up the columns. The code looks fine, to me.


After modifying the code you provided it appears that it takes the two data columns and create a unique list of values from both.

Not exactly what I was looking for as you can see from the 'after' picture I created above. The blanks in column I and M are there as spacing for missing values.

(If "I" has a value that "M" doesn't have there is a blank in "M". If "M" has value that "I" doesn't have there is a blank in "I". Where both have values they are side by side. "I" can have blank rows, "M" will not.)

I do not need a unique single list.
Either list needs to be shifted up or down so they "align".

So that we wind up with something like (with TGML tags):
[tt]
I M
1 1
2 3
4 5
6
7
7 8

Produces
I M
1 1
2
3
4
5
6
7 7
8
[/tt]

 

[SkipVought]

In your OP, you had NO VALUES for "missing" values.
[tt]
256 2 256 5
257 2
258 2 258 2
263 1
280 7 280 2
282 1
464 1
521 1
etc. etc.
[/tt]
Is that really your expected output?

My results...
[tt]
258 2 258 2
263 1
280 7 280 2
282 1
464 1
521 1
[/tt]
looks pretty close to me.

I grant you that I did not put an empty row where you had it. empty rows/columns are a blot, bane, and blight. They are to be avoided.

If you want ALL possible values, make a list MIN to MAX and do simple LOOKUPS. no need for VBA. You got a real good VBA example to work from, otherwise.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]