Mutliple sorting

S

SIFS

New Member
Joined
Oct 11, 2010
Messages
13
Hi,
I have data on seven worksheets, examples below:
[TABLE="width: 299"]
<colgroup><col><col><col span="2"></colgroup><tbody>[TR]
[TD="colspan: 2, align: left"]Worksheet 1[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: left"]Name[/TD]
[TD="align: center"]Contact number[/TD]
[TD="align: left"]Quantity[/TD]
[TD="align: left"]Company[/TD]
[/TR]
[TR]
[TD="align: left"]Richard[/TD]
[TD="align: center"]1234[/TD]
[TD="align: center"]10000[/TD]
[TD="align: left"]Amazon[/TD]
[/TR]
[TR]
[TD="align: left"]Mike[/TD]
[TD="align: center"]2345[/TD]
[TD="align: center"]5000[/TD]
[TD="align: left"]Amazon[/TD]
[/TR]
[TR]
[TD="align: left"]Michael[/TD]
[TD="align: center"]5678[/TD]
[TD="align: center"]3000[/TD]
[TD="align: left"]Amazon[/TD]
[/TR]
[TR]
[TD="align: left"]Nancy[/TD]
[TD="align: center"]4567[/TD]
[TD="align: center"]5000[/TD]
[TD="align: left"]Amazon[/TD]
[/TR]
[TR]
[TD="align: left"]Alpha[/TD]
[TD="align: center"]6789[/TD]
[TD="align: center"]8000[/TD]
[TD="align: left"]Amazon[/TD]
[/TR]
[TR]
[TD="align: left"]Bravo[/TD]
[TD="align: center"]7890[/TD]
[TD="align: center"]9000[/TD]
[TD="align: left"]Amazon[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 2, align: left"]Worksheet 2[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: left"]Name[/TD]
[TD="align: center"]Contact number[/TD]
[TD="align: left"]Quantity[/TD]
[TD="align: left"]Company[/TD]
[/TR]
[TR]
[TD="align: left"]Richard[/TD]
[TD="align: center"]5190[/TD]
[TD="align: center"]10000[/TD]
[TD="align: left"]Facebook[/TD]
[/TR]
[TR]
[TD="align: left"]Graham[/TD]
[TD="align: center"]2530[/TD]
[TD="align: center"]5000[/TD]
[TD="align: left"]Facebook[/TD]
[/TR]
[TR]
[TD="align: left"]Mark[/TD]
[TD="align: center"]5165[/TD]
[TD="align: center"]3000[/TD]
[TD="align: left"]Facebook[/TD]
[/TR]
[TR]
[TD="align: left"]Sara[/TD]
[TD="align: center"]1234[/TD]
[TD="align: center"]5000[/TD]
[TD="align: left"]Facebook[/TD]
[/TR]
[TR]
[TD="align: left"]David[/TD]
[TD="align: center"]8565[/TD]
[TD="align: center"]8000[/TD]
[TD="align: left"]Facebook[/TD]
[/TR]
</tbody>[/TABLE]

I need to consolidate this data in a way that same name and mobile number come together. For example, in below consolidated sheet, Sara has same contact number like Richard so Sara is reported with Richard and Richard's both entries are coming together.
[TABLE="width: 299"]
<colgroup><col><col><col span="2"></colgroup><tbody>[TR]
[TD="colspan: 2, align: left"]
Desired result[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: left"]Name[/TD]
[TD="align: center"]Contact number[/TD]
[TD="align: left"]Quantity[/TD]
[TD="align: left"]Company[/TD]
[/TR]
[TR]
[TD="align: left"]Richard[/TD]
[TD="align: center"]1234[/TD]
[TD="align: center"]10000[/TD]
[TD="align: left"]Amazon[/TD]
[/TR]
[TR]
[TD="align: left"]Richard[/TD]
[TD="align: center"]5190[/TD]
[TD="align: center"]10000[/TD]
[TD="align: left"]Facebook[/TD]
[/TR]
[TR]
[TD="align: left"]Sara[/TD]
[TD="align: center"]1234[/TD]
[TD="align: center"]5000[/TD]
[TD="align: left"]Facebook[/TD]
[/TR]
[TR]
[TD="align: left"]Mike[/TD]
[TD="align: center"]2345[/TD]
[TD="align: center"]5000[/TD]
[TD="align: left"]Amazon[/TD]
[/TR]
[TR]
[TD="align: left"]Michael[/TD]
[TD="align: center"]5678[/TD]
[TD="align: center"]3000[/TD]
[TD="align: left"]Amazon[/TD]
[/TR]
[TR]
[TD="align: left"]Nancy[/TD]
[TD="align: center"]4567[/TD]
[TD="align: center"]5000[/TD]
[TD="align: left"]Amazon[/TD]
[/TR]
[TR]
[TD="align: left"]Alpha[/TD]
[TD="align: center"]6789[/TD]
[TD="align: center"]8000[/TD]
[TD="align: left"]Amazon[/TD]
[/TR]
[TR]
[TD="align: left"]Bravo[/TD]
[TD="align: center"]7890[/TD]
[TD="align: center"]9000[/TD]
[TD="align: left"]Amazon[/TD]
[/TR]
[TR]
[TD="align: left"]Graham[/TD]
[TD="align: center"]2530[/TD]
[TD="align: center"]5000[/TD]
[TD="align: left"]Facebook[/TD]
[/TR]
[TR]
[TD="align: left"]Mark[/TD]
[TD="align: center"]5165[/TD]
[TD="align: center"]3000[/TD]
[TD="align: left"]Facebook[/TD]
[/TR]
[TR]
[TD="align: left"]David[/TD]
[TD="align: center"]8565[/TD]
[TD="align: center"]8000[/TD]
[TD="align: left"]Facebook[/TD]
[/TR]
</tbody>[/TABLE]

Please help and oblige.
Regards,
SIFS
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
Hi SIFS,
The below macro assumes that each worksheet to be processed has the text "Name" in cell A1.
The macro creates a worksheet named "Merged Data" and sorts it using generated a sort key created in column A:
Code: 
Option Explicit
Const MergeSheetName As String = "Merged Data"

Sub MergeSheets()

Dim dicMergeData As Object

Dim lEndRow As Long
Dim lEndCol As Long
Dim lColPtr As Long
Dim lRowPtr As Long
Dim lMergePtr As Long

Dim rFrom As Range
Dim rTo As Range
Dim sKey As String
Dim sSearchKey As String
Dim sSearchItem As String

Dim vaCurSheetData As Variant
Dim vaMergeData As Variant

Dim wsCur As Worksheet
Dim wsMerge As Worksheet

On Error Resume Next
dicMergeData.RemoveAll
Set dicMergeData = Nothing
On Error GoTo 0
Set dicMergeData = CreateObject("Scripting.Dictionary")

vaMergeData = False

For Each wsCur In ThisWorkbook.Worksheets
    If wsCur.Name <> MergeSheetName Then
        If wsCur.Range("A1").Value = "Name" Then
        
             Application.StatusBar = "Processing worksheet '" & wsCur.Name & "'"
             
             With wsCur
                If IsArray(vaMergeData) = False Then
                    lEndCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
                End If
            
                lEndRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                vaCurSheetData = .Range("A1").Resize(lEndRow, lEndCol).Value
                
                If IsArray(vaMergeData) = False Then
                    ReDim vaMergeData(1 To lEndCol + 1, 1 To 1)
                    lMergePtr = 1
                    vaMergeData(1, 1) = "Sort Key"
                    For lColPtr = 1 To lEndCol
                        vaMergeData(lColPtr + 1, 1) = vaCurSheetData(1, lColPtr)
                    Next lColPtr
                End If
                
                For lRowPtr = 2 To lEndRow
                
                    sKey = NormaliseString(Stringx:=CStr(vaCurSheetData(lRowPtr, 1)))
                    sSearchKey = NormaliseString(Stringx:=CStr(vaCurSheetData(lRowPtr, 2)))
                    
                    If dicMergeData.exists(sSearchKey) = True Then
                        sKey = dicMergeData.Item(sSearchKey)
                    Else
                        dicMergeData.Add Key:=sSearchKey, Item:=sKey
                    End If
                    
                    lMergePtr = lMergePtr + 1
                    ReDim Preserve vaMergeData(1 To lEndCol + 1, 1 To lMergePtr)
                    vaMergeData(1, lMergePtr) = sKey
                    For lColPtr = 1 To lEndCol
                        vaMergeData(lColPtr + 1, lMergePtr) = vaCurSheetData(lRowPtr, lColPtr)
                    Next lColPtr
                Next lRowPtr
                
            End With
        End If
    End If
Next wsCur


On Error Resume Next
Set wsMerge = Nothing
Set wsMerge = Sheets(MergeSheetName)
On Error GoTo 0
If wsMerge Is Nothing Then
    With ThisWorkbook
        Set wsMerge = .Sheets.Add(before:=.Sheets(1))
        wsMerge.Name = MergeSheetName
    End With
End If

Application.StatusBar = "Writing Results to worksheet '" & wsMerge.Name & "'"

wsMerge.Cells.ClearContents

With wsMerge
    lEndRow = UBound(vaMergeData, 2)
    lEndCol = UBound(vaMergeData, 1)
    .Range("A1").Resize(lEndRow, lEndCol).Value = WorksheetFunction.Transpose(vaMergeData)

    .Range("A1").Resize(1, lEndCol).Font.Bold = True
    .Columns(GetColLetter(1, lEndCol)).EntireColumn.AutoFit
    
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=Range("A2:A" & lEndRow), _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending, _
                        DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range("B2:B" & lEndRow), _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending, _
                        DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range("C2:C" & lEndRow), _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending, _
                        DataOption:=xlSortNormal

    With wsMerge.Sort
        .SetRange wsMerge.Range("A1").Resize(lEndRow, lEndCol)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With

Application.StatusBar = False

End Sub

Private Function NormaliseString(ByVal Stringx As String) As String
Dim lPtr As Long

Dim sCur As String
Dim sResult As String

sResult = ""
For lPtr = 1 To Len(Stringx)
    sCur = LCase$(Mid$(Stringx, lPtr, 1))
    If sCur <> UCase$(sCur) _
    Or IsNumeric(sCur) Then
        sResult = sResult & sCur
    End If
Next lPtr
NormaliseString = sResult

End Function

Private Function GetColLetter(ByVal Col1 As Long, _
                              Optional Col2 As Long = 0) As String
Dim sCol As String

sCol = ThisWorkbook.Sheets(1).Cells(1, Col1).Address(True, False)
GetColLetter = Left$(sCol, InStr(sCol, "$") - 1)
If Col2 > 0 Then
    sCol = ThisWorkbook.Sheets(1).Cells(1, Col2).Address(True, False)
    GetColLetter = GetColLetter & ":" & Left$(sCol, InStr(sCol, "$") - 1)
End If
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Allocation a number to specific column
Replies
0
Views
280
shahsavand
S
M
  • Question Question
SUM All the Action from Users
Replies
3
Views
551
Aladin Akyurek
Aladin Akyurek
R
  • Question Question
Sorting by columns then deleting rows
Replies
6
Views
601
RodneyW
R
A
  • Question Question
Vlookup to sum totals
Replies
1
Views
476
prabby25101981
P

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top