VBA - Loop - Copy matching cells from another sheet

[Sisma]

Hello everybody,

I am doing a project for HS and ran into a wall with a macro. The solution might be quite simple but I do not have the knowledge yet to solve it by myself.

So, I have a file with multiple exported sheets that I edited in the right format with a macro. Then I copy the columns "Host code" and "Host name" to "Sheet1" and by the value in "host code" count all the matches in "Sheet 2" and display the value in "quantity". I then insert the corresponding number of empty rows below that row. I managed to make those macros to work but have a lot of issues with the next step



What I would like to do now is populate those cells below "host name" (column B) with the corresponding "gear text" (column C) from "sheet 2". So, if a host has 5 types of gear, 5 empty rows were already created below his entry in "Sheet 1" and now need to be populated with the matching "gear text" from "sheet 2". Some Hosts have 0 gear, so nothing gets copied (their code is not present in "sheet 2"), some hosts have up to 15 types of gear.

Sheet 1:

Sheet 2:

If anyone could give me a helping hand, I would be really grateful. Thank you!

 

[Sharid]

This is not 100% what you want, I used this for a project, code was done by Fluff. I also am not 100% sure what you want, but the way I understand it you want the Gear data linked to the Host Code and the that many rows.

So Host code 4 will have 2 blank rows and Host code 6 will have 4 blank rows.

The code below will do the matching, only, but does put the Gear data in the wrong column. You need that in C and only number value and then that many rows. I think that is what you want.

The data in red should not be copied over but ONLY used to match the records. Hopfully a more experienced member can help you or you can tweek the code

I have placed everything on 1 page only for the picture, The data in H to J was on sheet2

Private Sub CommandButton1_Click()

   Dim s1 As Worksheet, s2 As Worksheet
   Dim Cl As Range
   
   Set s1 = Sheets("Sheet1")
   Set s2 = Sheets("Sheet2")
   
   Application.ScreenUpdating = False
   With CreateObject("scripting.dictionary")
      For Each Cl In s2.Range("b2", s2.Range("b" & Rows.Count).End(xlUp))
        .Item(Cl.Value) = Cl.Resize(, 27)
      Next Cl
     For Each Cl In s1.Range("a2", s1.Range("a" & Rows.Count).End(xlUp))
         Cl.Offset(, 2).Resize(, 27).Value = .Item(Cl.Value)
     Next Cl
   End With

End Sub