PDA

View Full Version : Extract data from columns [sum]



LinkND
07-02-2008, 04:01 AM
I am working on a list of values with company names and their employees. Every company name is unique, but has different unique daughter companies. So for example, I have company number 1, with sub_company 1, 2 and 3. Company number 2, with sub_company 1 and 2, etc.

Alright, every sub_company within a total company has different employees. You can count all the employees and make a list of companies with the biggest on top. This list is already created, as the list with the top companies.

What I want to do is find the total amount of employees for every sub_company by looping through the list at the left. Because every sub_company can be listed more than once, it needs to count all the employees together. I want to create this list only for the top 3 companies in the list (the list in the middle). Even though that list with top companies can be 1000 rows long, only the first three will be used.

I've attached an example workbook to this post, because you will see exactly what I want to accomplish.

LinkND
07-09-2008, 03:05 AM
I managed to make something happen in the mean time =) maybe it's kind of cheap to do it this way, but I still need to fix the last part. I am copying the data from the highest three to Sheet2 in column A. The data comes from Sheet1.....

I am still struggling with the code to merge the daughter companies and count the total amount of employees. In Sheet2 is the desired result.

Option Explicit
Sub AllCompanies()
Dim LastRow As Long
Dim cpDataT1 As Long
Dim i As Long

With Sheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If .Cells(i, "A").Value = [Sheet3!B4] Then
cpDataT1 = cpDataT1 + 1
.Rows(i).Copy Worksheets("Sheet2").Range("A" & cpDataT1)
End If
Next i
End With

With Sheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If .Cells(i, "A").Value = [Sheet3!B5] Then
cpDataT1 = cpDataT1 + 1
.Rows(i).Copy Worksheets("Sheet2").Range("A" & cpDataT1)
End If
Next i
End With

With Sheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If .Cells(i, "A").Value = [Sheet3!B6] Then
cpDataT1 = cpDataT1 + 1
.Rows(i).Copy Worksheets("Sheet2").Range("A" & cpDataT1)
End If
Next i
End With
End Sub