Match data from 2 columns and shift row to align

elizabott · Mar 11th 2015

I am trying to match data like this (as an example):
[TABLE="class: grid, width: 500"]

[tr]

[td]

Suburb 1

[/td]

[td]

Suburb 2

[/td]

[td]

Apples

[/td]

[td]

Oranges

[/td]

[td]

Bananas

[/td]

[/tr]

[tr]

[td]

A

[/td]

[td]

F

[/td]

[td]

2

[/td]

[td]

6

[/td]

[td]

7

[/td]

[/tr]

[tr]

[td]

C

[/td]

[td]

E

[/td]

[td]

4

[/td]

[td]

3

[/td]

[td]

4

[/td]

[/tr]

[tr]

[td]

B

[/td]

[td]

D

[/td]

[td]

5

[/td]

[td]

4

[/td]

[td]

3

[/td]

[/tr]

[tr]

[td]

D

[/td]

[td]

C

[/td]

[td]

4

[/td]

[td]

5

[/td]

[td]

7

[/td]

[/tr]

[/TABLE]

to this, so that the data from apples, oranges and bananas shifts WITH suburb 2 to match up with suburb 1.
[TABLE="class: grid, width: 500"]

[tr]

[td]

Suburb 1

[/td]

[td]

Suburb 2

[/td]

[td]

Apples

[/td]

[td]

Oranges

[/td]

[td]

Bananas

[/td]

[/tr]

[tr]

[td]

A

[/td]

[td][/td]

[/tr]

[tr]

[td]

C

[/td]

[td]

C

[/td]

[td]

4

[/td]

[td]

5

[/td]

[td]

7

[/td]

[/tr]

[tr]

[td]

B

[/td]

[td][/td]

[/tr]

[tr]

[td]

D

[/td]

[td]

D

[/td]

[td]

5

[/td]

[td]

4

[/td]

[td]

3

[/td]

[/tr]

[/TABLE]

I have attached a spreadsheet. I can't figure out what the VBA code would be.

In the spreadsheet I want to match Column E with Column B and shift E:O to align with B. This code is matching E with A and moving A, C and D. I need A, C and D to stay where they are and match E with B and move E:O.

[ATTACH=CONFIG]64325[/ATTACH]

Code

Sub test()
    Dim SLA, i As Long, ii As Long, o, x
    SLA = Sheets("Sheet12").Cells(1).CurrentRegion.Value
    ReDim o(1 To UBound(SLA, 2))
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(SLA, 1)
            o(1) = SLA(i, 1): .Item(SLA(i, 1)) = o
        Next
        For i = 2 To UBound(SLA, 1)
            If .exists(SLA(i, 3)) Then
                o = .Item(SLA(i, 3))
            Else
                ReDim o(1 To UBound(SLA, 2))
            End If
            For ii = 2 To UBound(SLA, 2)
                o(ii) = SLA(i, ii)
            Next
            .Item(SLA(i, 3)) = o
        Next
        x = Application.Transpose(Application.Transpose(.items))
    End With
    With Sheets.Add.Cells(1).Resize(, UBound(x, 2))
        .Value = SLA
        .Offset(1).Resize(UBound(x, 1)).Value = x
        With .CurrentRegion
            .Columns.AutoFit
            .Rows.AutoFit
        End With
    End With
End Sub

Display More

pangolin · Mar 12th 2015

Re: Match data from 2 columns and shift row to align

see if this code helps

Code

Sub matchcpy()
Dim myarray()
Set myrange1 = Sheets("sheet1").Range("A2", Range("A" & Rows.Count).End(xlUp))
Set myrange2 = Sheets("sheet1").Range("B2", Range("B" & Rows.Count).End(xlUp))
On Error Resume Next
For Each cell In myrange2
If WorksheetFunction.IsError(WorksheetFunction.Match(cell.Value, myrange1, 0)) = True Then
For i = 0 To 3
cell.Offset(0, i).ClearContents
Next i
Else
x = x + 1
ReDim Preserve myarray(5, x)
myarray(1, x) = WorksheetFunction.Match(cell.Value, myrange1, 0)
For i = 0 To 3
myarray(i + 2, x) = cell.Offset(0, i).Value
cell.Offset(0, i).ClearContents
Next i
End If
Next cell
For p = 1 To x
For m = 2 To 5
Sheets("Sheet1").Range("B1").Offset(myarray(1, p), m - 2) = myarray(m, p)
Next m
Next p
End Sub

Display More

jindon · Mar 12th 2015

Re: Match data from 2 columns and shift row to align

This should do

Code

Sub test()
    Dim a, i As Long, x, txt As String, e
    With Cells(1).CurrentRegion
        With .Offset(1, 1)
            a = .Value: .ClearContents
            For i = 1 To UBound(a, 1)
                x = Application.Match(a(i, 1), .Offset(, -1).Columns(1), 0)
                If IsNumeric(x) Then txt = txt & "," & i & ";" & x
            Next
            For Each e In Split(Mid$(txt, 2), ",")
                .Rows(Split(e, ";")(1)).Value = Application.Index(a, Split(e, ";")(0), 0)
            Next
        End With
    End With
End Sub

Display More

apo · Mar 12th 2015

Re: Match data from 2 columns and shift row to align

pangolins and jindons code work beautifully...

Just for fun..

Do all the Suburbs that exist in the "Suburb1" column ALSO exist in the "Suburb2" column?

If they do.. and that's a big IF.. another way maybe would be:

* Create a sort string based on the "Suburb1" column like:

Code

Function sortVals() As String
 With Sheets("Sheet1").Range("A1").CurrentRegion
   sortVals = Join(Application.Transpose(.Offset(1).Columns(1).Value), ",")
 End With
End Function

* Then.. sort your values (not including your "Suburb1" column) by using the sortVals string as your CustomOrder.

Note: If your answer is No to my first question.. this won't work..

Match data from 2 columns and shift row to align

Participate now!

Share