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

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
1,935
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: 3

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
49,475
Office Version
  1. 365
Platform
  1. Windows
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
 

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
1,935
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
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: 0

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
49,475
Office Version
  1. 365
Platform
  1. Windows
Here is the corrected example
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
 

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
1,935

ADVERTISEMENT

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
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: 5

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
1,935
Sorry forgot to add sheet...

Unique
n1n2n3n4n5n6n7n8n9n10n11n12n13n14Part List1234567891011121314151617181920
1356101517181924789111213141620
71535891113161920241214
24561214
89101516191214
79151819201214
17121419
11220123456789101113141516171819
710174568911131415161819
4812141517192056911131618
1456911131618
1191620234567891011121314151718
910111314172345678121518
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
49,475
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Remaining list header would be in range R4:AK4
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
 
Solution

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
1,935
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
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 :)
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
49,475
Office Version
  1. 365
Platform
  1. Windows
Glad it helped. Thanks Moti for your kind words. :)
 

Forum statistics

Threads
1,136,954
Messages
5,678,755
Members
419,782
Latest member
gc75150

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
Top