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
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
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 !!!!
Regards Mick![]()
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
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
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.
wow ....prefect ....excellent sir ,
million thanks for your help and guidance
and for trying again and again till you found end result ...![]()
You're welcome
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks