VBA, require each line remaining part list.

[motilulla]

VBA, require each line remaining part list.

Hello,

1-I got unique part list in the cells M2:AF2
2-Sold part list in the B4:J2000
3-Need help with VBA that give a remaining part list in the cells M4:AF200 (comparing sold part of each line in the columns B:J with unique list M2:AF2)

											Unique
	Item	Item	Item	Item	Item	Item	Item	Item	Item		Part List	12	27	32	75	86	90	98	100	107	124	137	138	139	140	145	152	157	210	242	249
	Sold	Sold	Sold	Sold	Sold	Sold	Sold	Sold	Sold
	12	32	86	90	124	145	157	210	242		Remaining	27	75	98	100	107	137	138	139	140	152	249
	32	86	100	107	137	139	152	242	249		Remaining	12	27	75	90	98	124	138	140	145	157	210
	27	75	86	90							Remaining	12	32	98	100	107	124	137	138	139	140	145	152	157	210	242	249
	100	107	124	145	152	242					Remaining	12	27	32	75	86	90	98	137	138	139	140	157	210	249
											Remaining
											Remaining
											Remaining
											Remaining
											Remaining
											Remaining
											Remaining
											Remaining

For example the sample image is attached.

Thank you all.

I am using Excel 2000

Regards,
Moti

 

[Fluff]

How about

Sub motilula()
   Dim Main As Variant, Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nc As Long, m As Long
   Dim Flg As Boolean
   
   Main = Range("M2:AF2").Value2
   Ary = Range("B4:J" & Range("B" & Rows.Count).End(xlUp).Row).Value2
   ReDim Nary(1 To UBound(Ary), 1 To 20)
   For r = 1 To UBound(Ary)
      For m = 1 To UBound(Main, 2)
         For c = 1 To UBound(Ary, 2)
            If Ary(r, c) = Main(1, m) Then
               Flg = True
               Exit For
            End If
         Next c
         If Not Flg Then
            nc = nc + 1
            Nary(r, nc) = Main(1, m)
         End If
         Flg = False
      Next m
      nc = 0
   Next r
   Range("M4").Resize(r - 1, 20).Value = Nary
End Sub

 

[motilulla]

How about

Sub motilula()
   Dim Main As Variant, Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nc As Long, m As Long
   Dim Flg As Boolean
  
   Main = Range("M2:AF2").Value2
   Ary = Range("B4:J" & Range("B" & Rows.Count).End(xlUp).Row).Value2
   ReDim Nary(1 To UBound(Ary), 1 To 20)
   For r = 1 To UBound(Ary)
      For m = 1 To UBound(Main, 2)
         For c = 1 To UBound(Ary, 2)
            If Ary(r, c) = Main(1, m) Then
               Flg = True
               Exit For
            End If
         Next c
         If Not Flg Then
            nc = nc + 1
            Nary(r, nc) = Main(1, m)
         End If
         Flg = False
      Next m
      nc = 0
   Next r
   Range("M4").Resize(r - 1, 20).Value = Nary
End Sub

VBA is an Amazing Fluff, results are perfect, as I required.

Thank you very much for your help and time you spent to solve my query.

Have a nice weekend

Kind Regards
Moti

 

[Fluff]

You're welcome & thanks for the feedback.

 

[motilulla]

Hello Fluff, I want a completely change in a macro, which I did, thought after working on it that is it possible...

Please could you take a look in it?

1-main part list M2:AF2 compares with row 4 item B2:J2 and result the remaining list in the cells M4:AF4...now here is the situation complicate, it must compare with row4+5 cells M4:AF5 both cells item with main part list M2:AF2 list and give the remain item list in the M5:AF5...it must do till all the item has been checked and finish from the main part list...no remaining...END.

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

											Unique
	Item	Item	Item	Item	Item	Item	Item	Item	Item		Part List	12	27	32	75	86	90	98	100	107	124	137	138	139	140	145	152	157	210	242	249
	Sold	Sold	Sold	Sold	Sold	Sold	Sold	Sold	Sold
	12	32	86	90	124	145	157	210	242		Remaining	27	75	98	100	107	137	138	139	140	152	249
	32	86	100	107	137	139	152	242	249		Remaining	27	75	98	138	140
	27	75	86	90							Remaining	98	138	140
	100	107	124	145	152	242					Remaining	98	138	140
	98	107	145	210	242	249					Remaining	138	140
	12	98	138	140	242						End
	12	27	32								Remaining	75	86	90	98	100	107	124	137	138	139	140	145	152	157	210	242	249
	98	124	257								Remaining	75	86	90	100	107	137	138	139	140	145	152	157	210	242	249
	75	100	138	140	145	157	242	249			Remaining	86	90	107	137	139	152	210
	12	75	86	90	107	137	139	152	210		End
	152	249									Remaining	12	27	32	75	86	90	98	100	107	124	137	138	139	140	145	157	210	242
	107	124	137	139	140	157					Remaining	12	27	32	75	86	90	98	100	138	145	210	242

For new example the sample image is attached.

Kind Regards
Moti

 

[Fluff]

As this is now totally different from your original question, it needs a new thread.