I require VBA help, tricky remaining list of numbers inside the cycle?

M

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,360
Office Version
  1. 2010
Hello,

I want VBA help to find remaining list of numbers inside the cycle list, which is a bit tricky task here below I have tried to explain if it is not clear please ask the question.

Step1-I got main list of numbers in the cells M2:AF2, I want this list to be checked with range B4:J4 numbers and after finding the remaining numbers, list them in range M4:AF4 under each corresponding number of the main list.

Step2-which complicate the situation, now main list must be checked (with 2 rows) with range B4:J4 numbers and after finding the remaining numbers, list them in range M5:AF5 under each corresponding number of the main list.

Step3-it must search remaining numbers till main list number are finished...when none number is left...END the search. (In this example in the range B9:J9 all numbers are over)

Step4-then start new remaining lists calculation, and continues the same task for next rows till end of the list find in the columns B:J

Unique
n1n2n3n4n5n6n7n8n9Number List1234567891011121314151617181920
1356101517181924789111213141620
358911131619202471214
245671214
891015161971214
79151819201214
17121419
1234567891011121314151617181920
7101745689111213141516181920
4812141517192056911131618
1456911131618
1620123456789101112131415171819
910111314171234567812151819

About these example results sample image is attached.

Kind Regards
Moti
 

Attachments

  • Remaining Numbers List.png
    Remaining Numbers List.png
    18.7 KB · Views: 4

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Sort by date Sort by votes
In your results, why are the highlighted numbers not directly under their column heading?

motilulla_1.xlsm
MNOPQRSTUV
212345678910
3
424789
5247
67
77
8
9
1045678910
1145689
12569
13
1412345678910
1512345678
Sheet2
 
Upvote 0
Peter_SSs said:
In your results, why are the highlighted numbers not directly under their column heading?

motilulla_1.xlsm
MNOPQRSTUV
212345678910
3
424789
5247
67
77
8
9
1045678910
1145689
12569
13
1412345678910
1512345678
Sheet2
Click to expand...
Peter_SSs, I apologize, it is my typo error, all it should be under the header. Here is the corrected example

Unique
n1n2n3n4n5n6n7n8n9Number List1234567891011121314151617181920
1356101517181924789111213141620
358911131619202471214
245671214
891015161971214
79151819201214
17121419
1234567891011121314151617181920
7101745689111213141516181920
4812141517192056911131618
1456911131618
1620123456789101112131415171819
910111314171234567812151819

Kind Regards
Moti
 

Attachments

  • Remaining Numbers List.png
    Remaining Numbers List.png
    18.7 KB · Views: 3
Upvote 0
motilulla said:
Here is the corrected example
Click to expand...
OK, thanks. Give this a try.

VBA Code: 
Sub Remaining()
  Dim d As Object
  Dim a As Variant
  Dim r As Long, c As Long, uba2 As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  Reload_Dict d, Range("M2:AF2")
  a = Range("B4:J" & Range("B" & Rows.Count).End(xlUp).Row).Value2
  uba2 = UBound(a, 2)
  Application.ScreenUpdating = False
  For r = 1 To UBound(a)
    For c = 1 To uba2
      If IsEmpty(a(r, c)) Then Exit For
      d(a(r, c)) = vbNullString
    Next c
    Range("M4:AF4").Rows(r).Value2 = d.Items()
    If Join(d.Items(), "") = vbNullString Then Reload_Dict d, Range("M2:AF2")
  Next r
  Application.ScreenUpdating = True
End Sub

Sub Reload_Dict(Dict As Object, Vals As Range)
  Dim c As Range
  
  For Each c In Vals
    Dict(c.Value2) = c.Value2
  Next c
End Sub
 
Upvote 0
Peter_SSs said:
OK, thanks. Give this a try.

VBA Code: 
Sub Remaining()
  Dim d As Object
  Dim a As Variant
  Dim r As Long, c As Long, uba2 As Long
 
  Set d = CreateObject("Scripting.Dictionary")
  Reload_Dict d, Range("M2:AF2")
  a = Range("B4:J" & Range("B" & Rows.Count).End(xlUp).Row).Value2
  uba2 = UBound(a, 2)
  Application.ScreenUpdating = False
  For r = 1 To UBound(a)
    For c = 1 To uba2
      If IsEmpty(a(r, c)) Then Exit For
      d(a(r, c)) = vbNullString
    Next c
    Range("M4:AF4").Rows(r).Value2 = d.Items()
    If Join(d.Items(), "") = vbNullString Then Reload_Dict d, Range("M2:AF2")
  Next r
  Application.ScreenUpdating = True
End Sub

Sub Reload_Dict(Dict As Object, Vals As Range)
  Dim c As Range
 
  For Each c In Vals
    Dict(c.Value2) = c.Value2
  Next c
End Sub
Click to expand...
Peter, VBA is Woking as treat thank you so much for your kind help and time you spent to solve me query.

I need one more favour, which I find my mistake after the trying and working with my data in some cases some time I need to add few left numbers in the same line.

Please could you alter the macro that can work with this following layout? I want to leave column B to F blank where if necessary I insert few number and run the macro give me the results as per new request. Remaining list header would be in range R4:AK4 and numbers range would be column B:O.

I am sorry to bother you again please help

Kind Regards
Moti
 

Attachments

  • Remaining Numbers List-New.png
    Remaining Numbers List-New.png
    20.1 KB · Views: 7
Upvote 0
Sorry forgot to add sheet...

Unique
n1n2n3n4n5n6n7n8n9n10n11n12n13n14Part List1234567891011121314151617181920
1356101517181924789111213141620
71535891113161920241214
24561214
89101516191214
79151819201214
17121419
11220123456789101113141516171819
710174568911131415161819
4812141517192056911131618
1456911131618
1191620234567891011121314151718
910111314172345678121518
 
Upvote 0
motilulla said:
Remaining list header would be in range R4:AK4
Click to expand...
I wasn't quite sure what this meant & I cannot see any of your row numbers so I have shown my layout below the code.

VBA Code: 
Sub Remaining()
  Dim d As Object
  Dim a As Variant
  Dim r As Long, c As Long, uba2 As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  Reload_Dict d, Range("R2:AK2")
  a = Range("B4:O" & Range("G" & Rows.Count).End(xlUp).Row).Value2
  uba2 = UBound(a, 2)
  Application.ScreenUpdating = False
  For r = 1 To UBound(a)
    For c = 1 To uba2
      If Not IsEmpty(a(r, c)) Then d(a(r, c)) = vbNullString
    Next c
    Range("R4:AK4").Rows(r).Value2 = d.Items()
    If Join(d.Items(), "") = vbNullString Then Reload_Dict d, Range("R2:AK2")
  Next r
  Application.ScreenUpdating = True
End Sub

Sub Reload_Dict(Dict As Object, Vals As Range)
  Dim c As Range
  
  For Each c In Vals
    Dict(c.Value2) = c.Value2
  Next c
End Sub

motilulla_1.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAK
1Unique
2n1n2n3n4n5n6n7n8n9n10n11n12n13n14Number List1234567891011121314151617181920
3
41356101517181924789111213141620
571535891113161920241214
624561214
789101516191214
879151819201214
917121419
1011220123456789101113141516171819
11710174568911131415161819
124812141517192056911131618
131456911131618
141191620234567891011121314151718
15910111314172345678121518
Sheet3
 
Upvote 0
Solution
Peter_SSs said:
I wasn't quite sure what this meant & I cannot see any of your row numbers so I have shown my layout below the code.

VBA Code: 
Sub Remaining()
  Dim d As Object
  Dim a As Variant
  Dim r As Long, c As Long, uba2 As Long
 
  Set d = CreateObject("Scripting.Dictionary")
  Reload_Dict d, Range("R2:AK2")
  a = Range("B4:O" & Range("G" & Rows.Count).End(xlUp).Row).Value2
  uba2 = UBound(a, 2)
  Application.ScreenUpdating = False
  For r = 1 To UBound(a)
    For c = 1 To uba2
      If Not IsEmpty(a(r, c)) Then d(a(r, c)) = vbNullString
    Next c
    Range("R4:AK4").Rows(r).Value2 = d.Items()
    If Join(d.Items(), "") = vbNullString Then Reload_Dict d, Range("R2:AK2")
  Next r
  Application.ScreenUpdating = True
End Sub

Sub Reload_Dict(Dict As Object, Vals As Range)
  Dim c As Range
 
  For Each c In Vals
    Dict(c.Value2) = c.Value2
  Next c
End Sub

motilulla_1.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAK
1Unique
2n1n2n3n4n5n6n7n8n9n10n11n12n13n14Number List1234567891011121314151617181920
3
41356101517181924789111213141620
571535891113161920241214
624561214
789101516191214
879151819201214
917121419
1011220123456789101113141516171819
11710174568911131415161819
124812141517192056911131618
131456911131618
141191620234567891011121314151718
15910111314172345678121518
Sheet3
Click to expand...
Peter, you have nailed it. This is exactly in my ranges as per your layout and it works accordingly and beyond magic.

I want to thank you for resolving my second request as well.

Have a great weekend & good luck!

Kind Regards
Moti :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
Sort scripture references by chapter number
Replies
9
Views
215
Peter_SSs
Peter_SSs
P
  • Question
vba at each change
2
Replies
15
Views
672
kevin9999
K
JTL9161
  • Solved
Calculating Golf Handicap
2
Replies
10
Views
359
Fluff
Fluff
K
  • Question
conditional formatting question
Replies
2
Views
151
kerm007
K
R
  • Question
Unified DDMMYY with variable data
2
Replies
11
Views
263
Alex Blakenburg
A

Forum statistics

Threads
1,214,599
Messages
6,120,453
Members
448,967
Latest member
grijken

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