Looking for some guidance

[paulsolar]

Hi All

I'm looking for a pointer where to start with this problem.

I have two worksheets, sheet1 and sheet2.

Sheet1 contains businesses whose credentials are correct. Column A has the businesses Ref No, Columns B-H contain the businesses name and contact details.

Sheet2 contains the businesses names with an individual row for each of thier employees, the good thing is that Column A has the businesses Ref No.

So for example Sheet2 Column A could have 5 entries with the same number, next to which are 5 employees details in columns B-E.

What I want achieve is in Sheet3 have the businesses details in columns A-H, and below that row list the employees details for that business. Then underneath the last employee row for the previous business have the next business followed by its employees..................

I've been trying to figure out an easy way of doing this without any success.

any suggestions on how to go about it would be greatly appreciated.

Cheers

Paul

 

[Fluff]

How about

Sub CombineData()

   Dim Cl As Range
   Dim i As Long
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   
Application.ScreenUpdating = False
   Set Ws1 = Sheets("Sheet2")
   Sheets("sheet1").Copy , Sheets(Sheets.Count)
   ActiveSheet.Name = "Combined"
   Set Ws2 = Sheets("Combined")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Cl.Resize(, 5)
         Else
            Set .Item(Cl.Value) = Union(.Item(Cl.Value), Cl.Resize(, 5))
         End If
      Next Cl
      For i = Ws2.Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
         If .exists(Ws2.Range("A" & i).Value) Then
            Rows(i + 1).Resize(.Item(Ws2.Range("A" & i).Value).Rows.Count).Insert
            Ws2.Range("A" & i + 1).Resize(.Item(Ws2.Range("A" & i).Value).Rows.Count, 5).Value = .Item(Ws2.Range("A" & i).Value).Value
         End If
      Next i
   End With
End Sub

 

[paulsolar]

Hi Fluff

Many thanks for your reply, if i can get this to work, I'll pray tonight for England to beat Ireland on Saturday. (And thats going some for a Taff)

Could you give me a quick explanation of how this will work please so that I can test it, I cant quite figure out how to implement it

cheers

Paul

 

[paulsolar]

OK Fluff, I'm on my knees at this moment

Please dont tell anyone in Wales

Worked like a charm,

Thanks again for your assistance, it saved my wife about a 2 days work going through 35000 businesses

Cheers

Paul

 

[Fluff]

if i can get this to work, I'll pray tonight for England to beat Ireland on Saturday. (And thats going some for a Taff)

With the way we're playing at the moment, it will take a bit more than that!
We could easily end up 5th.

Sub CombineData()

         Dim Cl As Range
         Dim i As Long
         Dim Ws1 As Worksheet
         Dim Ws2 As Worksheet
         
1     Application.ScreenUpdating = False
2        Set Ws1 = Sheets("Sheet2")
3        Sheets("sheet1").Copy , Sheets(Sheets.Count)
4        ActiveSheet.Name = "Combined"
5        Set Ws2 = Sheets("Combined")
6        With CreateObject("scripting.dictionary")
7           For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
8              If Not .exists(Cl.Value) Then
9                 .Add Cl.Value, Cl.Resize(, 5)
10             Else
11                Set .Item(Cl.Value) = Union(.Item(Cl.Value), Cl.Resize(, 5))
12             End If
13          Next Cl
14          For i = Ws2.Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
15             If .exists(Ws2.Range("A" & i).Value) Then
16                Rows(i + 1).Resize(.Item(Ws2.Range("A" & i).Value).Rows.Count).Insert
17                Ws2.Range("A" & i + 1).Resize(.Item(Ws2.Range("A" & i).Value).Rows.Count, 5).Value = .Item(Ws2.Range("A" & i).Value).Value
18             End If
19          Next i
20       End With
End Sub

7) loops through Col A on sheet2
8) Checks if the value is already in the dictionary
9) if it's not in the dictionary it adds col A value as the key & the range A:E as the item
11) If the value already exists it adds the new range to the existing range held in the item
14) loops through col A on the newly created sheet "Combined"
15) Checks if the col A value exists in the dictionary
16) If it does, inserts a varying number of new rows below (so if that company has 5 employees it will add 5 new rows)
17) copies the employee details to the new rows

HTH

 

[Fluff]

Worked like a charm,

Glad to help & thanks for the feedback.

Please dont tell anyone in Wales

Don't worry I wont, It'd cost to much to get back out