+ Reply to Thread
Results 1 to 21 of 21

custom sort according to header in each sheet

Hybrid View

raj soni custom sort according to... 11-28-2014, 09:45 AM
MickG Re: custom sort according to... 11-28-2014, 11:49 AM
raj soni Re: custom sort according to... 11-28-2014, 12:00 PM
raj soni Re: custom sort according to... 11-28-2014, 12:21 PM
MickG Re: custom sort according to... 11-28-2014, 12:32 PM
raj soni Re: custom sort according to... 11-28-2014, 01:34 PM
raj soni Re: custom sort according to... 11-28-2014, 01:36 PM
MickG Re: custom sort according to... 11-28-2014, 02:05 PM
raj soni Re: custom sort according to... 11-28-2014, 02:09 PM
raj soni Re: custom sort according to... 11-30-2014, 09:52 AM
MickG Re: custom sort according to... 12-01-2014, 06:45 AM
raj soni Re: custom sort according to... 12-01-2014, 08:55 AM
MickG Re: custom sort according to... 12-01-2014, 09:42 AM
raj soni Re: custom sort according to... 12-01-2014, 01:31 PM
MickG Re: custom sort according to... 12-01-2014, 01:45 PM
  1. #1
    Forum Contributor
    Join Date
    04-25-2014
    Location
    India
    MS-Off Ver
    Excel pro plus 2021
    Posts
    186

    Re: custom sort according to header in each sheet

    sorry file above 1 mb , so cant upload here , so sending this two links

    https://www.dropbox.com/s/c7boknn7zs...FTER.xlsx?dl=0

    https://www.dropbox.com/s/m6h17d05dv...FORE.xlsx?dl=0

  2. #2
    Forum Expert MickG's Avatar
    Join Date
    11-23-2007
    Location
    Banbury,Oxfordshire
    Posts
    2,650

    Re: custom sort according to header in each sheet

    Try this:-
    NB:- Your sheet lists appear to be all the combination of the data on sheet "Order", But mixed up and in various Header order.
    The code now checks each line against a Data set of the appropriate combinations, Replacing the results in order on the sheet, as found , and with the appropriate number, added in column 6.
    Hope this is what you want !!!!
    Sub MG01Dec40
    'Mg 1/12/14
    Dim Ray(1 To 5) As Variant, c As Long
    Dim AcRng As Range, Dn As Range
    Dim R1 As Long, R2 As Long, R3 As Long, R4 As Long, R5 As Long
    Dim Rng As Range, n As Long, nn As Long
    Dim rRay As Variant, DicR As Object, Q As Long
    Dim Shts As Variant, Sh As Variant, G As Variant
    Dim nDic As Object
    Dim nRay As Variant
    Dim t
    t = Timer
    Set AcRng = Sheets("Order").Range("A1:E1")
    Set DicR = CreateObject("scripting.dictionary")
    DicR.CompareMode = vbTextCompare
        For Each Dn In AcRng
            With Sheets("Order")
                Set DicR(Dn.Value) = .Range(.Cells(2, Dn.Column), .Cells(Rows.Count, Dn.Column).End(xlUp))
            End With
        Next
    
    Shts = Array(1, 2, 3, 4)
    For Each Sh In Shts
    n = 0
    For Each Dn In Sheets(Sh).Range("A1:E1")
        n = n + 1
        Ray(n) = DicR.Item(Dn.Value)
    Next Dn
    
    ReDim aRay(1 To UBound(Ray(1)) * UBound(Ray(2)) * UBound(Ray(3)) * UBound(Ray(4)) * UBound(Ray(5)), 1 To 6)
    Set nDic = CreateObject("scripting.dictionary")
    nDic.CompareMode = vbTextCompare
    c = 0
    For R1 = 1 To UBound(Ray(1))
        For R2 = 1 To UBound(Ray(2))
            For R3 = 1 To UBound(Ray(3))
                For R4 = 1 To UBound(Ray(4))
                    For R5 = 1 To UBound(Ray(5))
                     c = c + 1
                     nDic(Ray(1)(R1, 1) & Ray(2)(R2, 1) & Ray(3)(R3, 1) & Ray(4)(R4, 1) & Ray(5)(R5, 1)) = c
                        aRay(c, 1) = Ray(1)(R1, 1)
                        aRay(c, 2) = Ray(2)(R2, 1)
                        aRay(c, 3) = Ray(3)(R3, 1)
                        aRay(c, 4) = Ray(4)(R4, 1)
                        aRay(c, 5) = Ray(5)(R5, 1)
                    Next R5
                Next R4
            Next R3
    Next R2
    Next R1
     
      With Sheets(Sh)
            nRay = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)).Resize(, 6)
            For n = 1 To UBound(nRay, 1)
                If nDic.exists(nRay(n, 1) & nRay(n, 2) & nRay(n, 3) & nRay(n, 4) & nRay(n, 5)) Then
                    Q = nDic.Item(nRay(n, 1) & nRay(n, 2) & nRay(n, 3) & nRay(n, 4) & nRay(n, 5))
                    aRay(Q, 6) = nRay(n, 6)
               End If
            Next n
            .Range("A2").Resize(UBound(aRay), 6) = aRay
    End With
    Next Sh
    MsgBox Timer - t
    End Sub
    Regards Mick

  3. #3
    Forum Contributor
    Join Date
    04-25-2014
    Location
    India
    MS-Off Ver
    Excel pro plus 2021
    Posts
    186

    Re: custom sort according to header in each sheet

    hello sir ,
    its 90 % working in right direction ,
    but its leaving black cells in between .
    if you check my "AFTER" sheet , there is no black cells .

    i think vba calculate A1:E1 from order sheet .
    but actual order should be
    ("A1:A10", "B1:B10", "C1:C8", "D1:D13", "E1:E7")
    but i am happy with this too , thank you for you help and cooperation

  4. #4
    Forum Expert MickG's Avatar
    Join Date
    11-23-2007
    Location
    Banbury,Oxfordshire
    Posts
    2,650

    Re: custom sort according to header in each sheet

    I meant to say, in your sheet "Order" for all data columns, below the cells in each column with Data, there are Blank cells that have something in them, and the code uses the blank cells.
    I don't know whats in them but I had the same trouble as you, before I found out what was causing it.
    What you need to do is move the whole range to some spare place on the worksheet and then Copy and paste back each individual column of data.
    Make sure you only copy the Data in each column.

  5. #5
    Forum Contributor
    Join Date
    04-25-2014
    Location
    India
    MS-Off Ver
    Excel pro plus 2021
    Posts
    186

    Re: custom sort according to header in each sheet

    wow ....prefect ....excellent sir ,

    million thanks for your help and guidance

    and for trying again and again till you found end result ...

  6. #6
    Forum Expert MickG's Avatar
    Join Date
    11-23-2007
    Location
    Banbury,Oxfordshire
    Posts
    2,650

    Re: custom sort according to header in each sheet

    You're welcome

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. VB Code Custom Sort then Insert Header
    By Intalzky in forum Excel General
    Replies: 3
    Last Post: 09-16-2014, 11:06 PM
  2. [SOLVED] How to save a custom header/footer on ea. sheet of a workbook?
    By auditthis in forum Excel Formulas & Functions
    Replies: 0
    Last Post: 09-06-2005, 02:05 PM
  3. [SOLVED] How to save a custom header/footer on ea. sheet of a workbook?
    By auditthis in forum Excel Formulas & Functions
    Replies: 0
    Last Post: 09-06-2005, 04:05 AM
  4. How to save a custom header/footer on ea. sheet of a workbook?
    By auditthis in forum Excel Formulas & Functions
    Replies: 0
    Last Post: 09-06-2005, 01:05 AM
  5. How to save a custom header/footer on ea. sheet of a workbook?
    By auditthis in forum Excel Formulas & Functions
    Replies: 0
    Last Post: 09-06-2005, 12:05 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1