VBA Code that uses CustomOrder to Sort in other Worksheet in the same Workbook

Veni11

New Member
Joined
Oct 20, 2023
Messages
22
Office Version
  1. 365
Platform
  1. Windows
Hii
I have a difficult issue for me as I'm still a bit new to VBA coding.
Here's what I'm trying to solve. I have an Excel template with different sheets. One of these sheets is called "MASTER" and it contains all the article numbers that are available and they are entered in a defined order. In the "Material" sheet there are various item numbers that are randomly distributed in a column, but these item numbers are all contained in the "MASTER" sheet. My goal is to sort the "Material" sheet based on the order in the "MASTER". The code should be structured in such a way that it doesn't matter which article numbers appear in the "Material" sheet, they are then sorted in the column as they are in the "Master". The range is C3:C4000 in the "MASTER" sheet.
In the end, the structure would be the same for each new "Material" sheet, even if not all item numbers are included.

I hope I described it understandable and that someone has an idea :D
 
How many rows do you have?
the rows in the sheet "Material" are dynamic, so there sometimes it could be 50 rows and sometimes up to 500.
the rows in the sheet "Master" are always the same 4000 rows C3:C4000..
Maybe I didn't explain that correctly
 
Upvote 0

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Oh by the way I forgot an End With in the end. Maybe it's because of that. I modified the code a bit. Try like this:
VBA Code:
Sub test()
  Dim masterArray As Variant, materialArray As Variant, tempArray As Variant
  Dim masterNumbers As Object
  Dim i As Long, j As Long, k As Long, c As Long
  Set masterNumbers = CreateObject("Scripting.Dictionary")
 
  With Worksheets("MASTER")
  masterArray = Application.Transpose(Intersect(.UsedRange, .Columns("C")))
  End With
 
  For i = 3 To UBound(masterArray)
    If Not masterNumbers.Exists(masterArray(i)) Then
      c = c + 1
      masterNumbers.Add masterArray(i), c
    End If
  Next

  With Worksheets("Material")
  materialArray = .UsedRange
  For i = 3 To UBound(materialArray, 1) - 1
    For j = i + 1 To UBound(materialArray, 1)
      If masterNumbers(materialArray(j, 3)) < masterNumbers(materialArray(i, 3)) Then
        Redim tempArray(1 to UBound(materialArray, 2))
        For k = 1 To UBound(materialArray, 2)
          tempArray(k) = materialArray(i, k)
          materialArray(i, k) = materialArray(j, k)
          materialArray(j, k) = tempArray(k)
        Next
      End If
    Next
  Next
  .UsedRange.Value = materialArray
  End With
End Sub
 
Upvote 0
Oh by the way I forgot an End With in the end. Maybe it's because of that. I modified the code a bit. Try like this:
VBA Code:
Sub test()
  Dim masterArray As Variant, materialArray As Variant, tempArray As Variant
  Dim masterNumbers As Object
  Dim i As Long, j As Long, k As Long, c As Long
  Set masterNumbers = CreateObject("Scripting.Dictionary")
 
  With Worksheets("MASTER")
  masterArray = Application.Transpose(Intersect(.UsedRange, .Columns("C")))
  End With
 
  For i = 3 To UBound(masterArray)
    If Not masterNumbers.Exists(masterArray(i)) Then
      c = c + 1
      masterNumbers.Add masterArray(i), c
    End If
  Next

  With Worksheets("Material")
  materialArray = .UsedRange
  For i = 3 To UBound(materialArray, 1) - 1
    For j = i + 1 To UBound(materialArray, 1)
      If masterNumbers(materialArray(j, 3)) < masterNumbers(materialArray(i, 3)) Then
        Redim tempArray(1 to UBound(materialArray, 2))
        For k = 1 To UBound(materialArray, 2)
          tempArray(k) = materialArray(i, k)
          materialArray(i, k) = materialArray(j, k)
          materialArray(j, k) = tempArray(k)
        Next
      End If
    Next
  Next
  .UsedRange.Value = materialArray
  End With
End Sub
The error message came at the beginning, I've already added it 😄but Excel is still loading maybe there are to many rows I don't know
 
Upvote 0
The error message came at the beginning, I've already added it 😄but Excel is still loading maybe there are to many rows I don't know
I don't know.. It should easily deal with 10.000+ rows without an issue.
Could you upload a sample file please?
 
Last edited by a moderator:
Upvote 0
I tested the code with Master sheet with 7000 rows and Material sheet with 5000 rows. Unfortunately, it is slow. I waited for 40 secs.
Sorry for the late response. I tried your sample file i waited 5 secs. But unfortunately it was not the outcome I was looking for. I'll try to make a sample file and send it here maybe it's gonna be clear then.
 
Upvote 0
I don't know.. It should easily deal with 10.000+ rows without an issue.
Could you upload a sample file please?


Here's the sample link. There you will see in the MASTER sheet some item numbers in a specific order. There are not all items yet. In the Material sheet you can see that the item numbers needed for the specific project are spread all over the sheet. Now the case is that the MASTER is the example everything should ordered as. So by running the code every item number should move to its position.
For example:
If the item number S1255-400 is above the item number N1122-200 in the MASTER sheet and in the Material sheet the item number N1122-200 is above the S1255-400, should the item Number S1255-400 jump over the other one after running the Code. And this for all other item numbers.

MASTER:

Row(3) = S1255-400
Row(224) = N1122-200

Material(before macro):

Row(57)=N1122-200
Row(123)=S1255-400

Material (after macro):

Row(e.g.5)=S1255-400
Row(e.g.6)=N1122-200

So that is basically what i mean in the simpliest way possible to describe. But let me know if you need more infos. Thank you!
 
Upvote 0
What if item number in Material does not exist in Master sheet?
I have to fill up the Master sheet so that in that sheet is every existing item. In the sample possibly you'll not find all items because it's just a sample so that you can imagine what I meant.
 
Upvote 0

Forum statistics

Threads
1,215,094
Messages
6,123,071
Members
449,092
Latest member
ipruravindra

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