Excel - Segregation - Advanced solutions may be required

[Abu4rmDXB]

Dear Awesome Excelians,

I'm at a stage in one of my teams' project where we need to segregate between the machines and their spare parts. Kindly find the attached file where I have shown the current situation and the required situation. At present we have the spare parts list on the left column and its associated machine numbers on the right columns.

We need to segregate by the machine number, i.e., vice versa, we need to have the machine numbers on the left column and have the spare parts for each associated machine on the right columns.

 

[Deepak]

It's possible through formula itself with a helper columns..

Here's a VBA..

Sub re_arrange_data()
Dim r As Range, i As Integer

For Each m In Range("A16:a25")
i = 1
    For Each r In Range("b3:e12")
        If r.Value = m.Value Then m.Offset(, i) = Cells(r.Row, 1):          i = i + 1
    Next
Next

End Sub

 

[p45cal]

This one will create the row headers too. See comments in code:

Sub blah()
Dim FoundMachine As Range
DestColm = "L" 'adjust to the column where the left of the new table will be. The top is below whatever is found in that column.
For Each cll In Range("B3:E12").Cells 'make this the data body: not the headers nor column A
  Set FoundMachine = Columns(DestColm).Find(what:=cll.Value, Lookat:=xlWhole, LookIn:=xlValues, searchformat:=False)
  If FoundMachine Is Nothing Then
    Set Destn = Cells(Rows.Count, DestColm).End(xlUp).Offset(1)
    Destn.Value = cll.Value
    Destn.Offset(, 1).Value = Cells(cll.Row, "A").Value
  Else
    FoundMachine.End(xlToRight).Offset(, 1).Value = Cells(cll.Row, "A").Value
  End If
Next cll
End Sub

 

[Abu4rmDXB]

Thanks a lot Deepak and p45cal for your inputs and quick response. Your support is highly appreciated by our team. I will install VB, work out with the above codes and get back to you shortly.

Thanks once again!

Have a nice day!

 

[p45cal]

Install VB?!
This is VBA and I think usually installs with Excel/Office.
In Excel, when on a sheet press Alt+F11, does anything come up? If so, you already have the necessary.

 

[Deepak]

As p45cal alrady said!!

It installs by default unless it is ticked out @ installation era.



If not repair then repair/add feature the office with the same.

 

[Abu4rmDXB]

WOW! Awesome! It worked. :D

But it did not work with my original case. Kindly share me your email ID so that I could send that file for your perusal since I cannot upload them here in this public forum.

Thanks a lot. Now I'm going to learn all the basics and eventually sharpen my skills. Kindly guide me from where I have to start to learn Excel and VBA completely.

It would be great if you could refer me some books to purchase from chandoo.org and I shall start my learning journey from here.

 

[Deepak]

@ Abu4rmDXB
********

 

[Abu4rmDXB]

Hi Deepak,

Kindly check the email.

Thanks.

 

[Abu4rmDXB]

Good Morning Deepak,

Thanks for your mail and I hope the same email and the original attachment is being shared with p45cal as well. I have tried the same formula again and the error "Run Time Error 1004" still prevails.

Could you please guide me in fixing the error and attaining the result as desired?

Your help will be highly appreciated.

P.S. Kindly guide me from where I have to start to learn Excel and VBA completely. It would be great if you could refer me some books to purchase from chandoo.org and I shall start my learning journey from here.

Have a pleasant day!

Thanks & Best Regards,
Abdul Rahman

 

[Abu4rmDXB]

Hi Everyone!

Kindly find the attached file where I have shown the sample and the real problems. The code stops working when it detects a blank space.

Kindly help me out in fixing the issue where I would like to have a result for the real problem as same as the result obtained for the sample problem.

Thanks for your help and advise.

Have a great day ahead!

 

[Nebu]

Hi:

I tweaked Pascal's code a bit. I guess this is what you are looking for.

Sub blah()
Dim FoundMachine As Range
DestColm = "H" 'adjust to the column where the left of the new table will be. The top is below whatever is found in that column.
For Each cll In Range("B3:F15").Cells 'make this the data body: not the headers nor column A
Set FoundMachine = Columns(DestColm).Find(what:=cll.Value, Lookat:=xlWhole, LookIn:=xlValues, searchformat:=False)
  If FoundMachine Is Nothing Then
    Set Destn = Cells(Rows.Count, DestColm).End(xlUp).Offset(1)
    Destn.Value = cll.Value
    Destn.Offset(, 1).Value = Cells(cll.Row, "A").Value
  ElseIf cll.Value <> vbNullString Then
    FoundMachine.End(xlToRight).Offset(, 1).Value = Cells(cll.Row, "A").Value
  End If
Next cll
End Sub

Thanks

 

[Abu4rmDXB]

@Nebu: Amazing!! the code worked! :D
Thanks a lot for your support. Highly appreciated!

Dear Deepak & p45cal,

Thanks a million for your impeccable support and cooperation. This forum is filled with energy and abundance of support. I also would like to extend my support to this community but before that I shall purchase some books from here and upgrade my skills to the next level. Looking forward to becoming an active member and help the other members by taking up their difficulties as a challenge and provide them with solutions!

Thanks a lot once again.

Have a pleasant day ahead.

Best Regards,
Abdul Rahman

 

[Abu4rmDXB]

Dear Team,

One last help. Hope you do not mind.

Kindly find the attached file. It is the same example but I would like to filter only the spare parts from the left column which does not have any machine numbers on their respective right columns. I have highlighted the cells which need to be filtered and displayed separately.

This code can also be merged with the previous segregation code if possible.

Thanks you very much.

Best Regards,
Abdul Rahman

 

[p45cal]

After Next cll in the existing macro add:

For Each rw In Range("B3:F15").Rows
    If Application.CountA(rw) = 0 Then Cells(Rows.Count, DestColm).End(xlUp).Offset(1).Value = rw.Cells(1).Offset(, -1).Value
Next rw

It will list the part numbers below the last machine number in the output.

 

[Abu4rmDXB]

Hi p45cal!

Thanks a lot! It worked.

Have a nice day.