• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Arrange data without using filters

ThrottleWorks

ThrottleWorks

Excel Ninja
Hi,

Please see attached file for reference.
At row number 2 is how actual data will look.

At row number 15 is the result I am trying to get. Please note, I am trying to get the result row number 2 itself.
This attached file is just for reference.

Original file will be like this.
Table one range A2:J11, this is my base table.
Table two is range L2:Q6

Once I arrange the data from table two, result will be similar to range L15:Q24 but will be arranged from range L2 itself.
There are 2 factors to be checked from table 1, Region and Account.
Please see row 3, table one region is Pune and Account is ABC12 so macro will find out combination of these two from second table and paste in row 3.
If you check original table 2, then row 3 has Nashik and XYZ55 so we need to re-arrange this table. Please see row 16 from table 2.

Ideally this should be the result in row 3 for second table. In this fashion we will arrange all the 4 records from table 2 against table 1.
I am using simple filter options in the macro to get the result but this is really time consuming.

One important thing is, one combination can have n number of records. For example Region Pune and Account ABC12 can have 3 records in table 1.
Can someone please guide me with a better method to arrange the data please. Take care.
 

Attachments

  • Arrange Data.xlsb
    9.3 KB · Views: 7
Last edited:
Please see attached file for more examples. In this file I have given direct result for table 2.
 

Attachments

  • Arrange Data.xlsb
    8.9 KB · Views: 10
Hi, according to the attachments a VBA demonstration for starters :​
Code: 
Private Function HCol(C$, L&)
            With Range("Y3:Z" & L).Columns
                .Item(1).Formula = "=CONCATENATE(" & C & ")"
                .Item(2).Formula = "=Y3&COUNTIF(Y$3:Y3,Y3)"
                 HCol = .Item(2).Value2
                .Clear
            End With
End Function

Sub Demo1()
    L& = [A1].CurrentRegion.Rows.Count
    R& = Cells(L + 1, 12).End(xlUp).Row:  If R < 3 Or R = L Then Beep: Exit Sub
    Cells(R + 1, 12).Value2 = "Not Present"
    V = Application.IfError(Application.Match(HCol("B3,C3", L), HCol("M3,N3", R), 0), R - 1)
    With Range("L3:Q" & L):  .Value2 = Application.Index(.Value2, V, [COLUMN(A:F)]):  End With
End Sub
Do you like it ? So thanks to click on bottom right Like !​
​
 
ThrottleWorks said:
Hi @shrivallabha , thanks for the help. Yes, you are correct.
Have a nice day ahead. :)
Click to expand...
See below code which you can adopt to suit your needs

Code: 
Option Explicit
Public Sub ReArrangeSecondTable()
Dim strTbl1Col1 As String, strTbl1Col2 As String, strTbl2Col1 As String, strTbl2Col2 As String, strTbl2FCol As String
Dim lngDataStartRow As Long, lngDataEndRow As Long, i As Long, lngTbl2ECol As Long
Dim varData
Dim objDict As Object

'\\ Set Definitions here
lngDataStartRow = 3  '\\ Where Data Starts
strTbl1Col1 = "B"    '\\ Table 1 # Column 1 to match
strTbl1Col2 = "C"    '\\ Table 1 # Column 2 to match
strTbl2Col1 = "M"    '\\ Table 2 # Column 1 to match
strTbl2Col2 = "N"    '\\ Table 2 # Column 2 to match
strTbl2FCol = "L"    '\\ Table 2 # First column for shifting rows
lngTbl2ECol = Cells(lngDataStartRow - 1, Columns.Count).End(xlToLeft).Column '\\ Table 2 # Last column for shifting rows
lngDataEndRow = Range(strTbl1Col1 & Rows.Count).End(xlUp).Row

'\\ Build Index Table
Set objDict = CreateObject("Scripting.Dictionary")
objDict.CompareMode = vbTextCompare
For i = lngDataStartRow To lngDataEndRow
    If Not objDict.Exists(Range(strTbl1Col1 & i).Value & "|" & Range(strTbl1Col2 & i).Value) Then
        objDict.Add Range(strTbl1Col1 & i).Value & "|" & Range(strTbl1Col2 & i).Value, i
    End If
Next i

'\\ Move Rows to desired locations
Application.ScreenUpdating = False
lngDataEndRow = Range(strTbl2Col1 & Rows.Count).End(xlUp).Row
For i = lngDataEndRow To lngDataStartRow Step -1
    If Len(Range(strTbl2Col1 & i).Value) > 0 And Len(Range(strTbl2Col2 & i).Value) > 0 Then
        If objDict.Exists(Range(strTbl2Col1 & i).Value & "|" & Range(strTbl2Col2 & i).Value) Then
            Range(Cells(i, strTbl2FCol), Cells(i, lngTbl2ECol)).Cut Cells(objDict.Item(Range(strTbl2Col1 & i).Value & "|" & Range(strTbl2Col2 & i).Value), strTbl2FCol)
        Else
            '\\ If table 2 contains a new combination then raise an error!
           MsgBox "ERR1: Combination : " & Range(strTbl2Col1 & i).Value & "|" & Range(strTbl2Col2 & i).Value & " does not exist in source table so cannot move!", vbExclamation
        End If
    End If
Next i

'\\ Fill Blank Cells
lngDataEndRow = Range(strTbl1Col1 & Rows.Count).End(xlUp).Row
On Error Resume Next
Range(Cells(lngDataStartRow, strTbl2FCol), Cells(lngDataEndRow, strTbl2FCol)).SpecialCells(xlCellTypeBlanks).Value = "Not Present"
On Error GoTo 0
Application.ScreenUpdating = True

End Sub
 
A variation without any temporary helper column (HCol) :​
Code: 
Private Function JoinNum$(Rf As Range, Rg As Range)
             Dim V
                 V = Application.Index(Rg.Value2, 1, 0)
            With Range(Rf, Rg).Columns
                 JoinNum = Join$(V, "¤") & "¤" & Application.CountIfs(.Item(1), V(1), .Item(2), V(2))
            End With
End Function

Sub Demo2()
        Dim L&, R&, S$(), T$(), N&
    With [A1].CurrentRegion.Columns("B:C").Rows
        L = .Count
        R = Cells(L + 1, 12).End(xlUp).Row:  If R < 3 Or R = L Then Beep: Exit Sub
        ReDim S(3 To L, 0), T(1 To R - 2)
        For N = 3 To L:  S(N, 0) = JoinNum(.Item(3), .Item(N)):  Next
    End With
    With Range("L3:Q" & L)
        With .Columns("B:C").Rows
            For N = 1 To R - 2:  T(N) = JoinNum(.Item(1), .Item(N)):  Next
        End With
           .Cells(R - 1, 1).Value2 = "Not Present"
           .Value2 = Application.Index(.Value2, Application.IfError(Application.Match(S, T, 0), R - 1), [COLUMN(A:F)])
    End With
End Sub
 
Thanks but you don't have to apologize every time.​
​
Post #9 code seems to have an issue​
and you should mention what is the maximum number of rows in first range within columns A:J in your real workbook …​
​
My post #11 demonstration just updated for a tiny optimization.​
​
 
Hi @shrivallabha sir, tried your code too, somehow am missing one record. Did not get time to check yet.
However no issues sir, at present I am using my code with FIND function.
Thanks a lot for the help. Have a nice day ahead. :)
 
You must log in or register to reply here.
Back
Top