VBA to copy data range from multiple sheets to mastersheet - Urgent help required!

[mileijit]

Hi,

I've been reading numerous posts, watching multiple youtube videos, and wildly searching the internet for several days now trying to figure out how to create a VBA/macro to suit my needs, but am still stuck scratching my head, so hopefully someone here can help me!

I have a workbook with nearly a hundred worksheets, so I'd like a Master worksheet to summarise the info!

Each worksheet tab is named with a specific project number (i.e. from 1000 to 1100)

The contents of each worksheet are in exactly the same position, and list the following:

• Staff names (in column B4 to B173)
• Their pay rates (in column C4 to C173)
• The headers May to December (in row E3 to L3)
• I manually input staff hours for each month (in the range E4 to L173)
• Total monthly hours for May to December of all staff are auto calculated (in row E175 to L175)
• Total monthly cost for May to December of all staff are auto calculated (in row E177 to L177)

What I'd like is a Master Project worksheet which automatically updates to list the following:

1. The project number (I don't mind manually adding these if necessary) - However if I do add a new project / worksheet tab, it'd be nice for it to be automatically added to the Master!
2. The total monthly project cost from May to December (i.e. the data in E177 to L177 in each worksheet) next to the corresponding project number

If anyone could help, it'd be a Godsend!

Thank you in advance - and please don't hesitate to let me know if you need further info or clarification.

 

[WarPigl3t]

Sub summayMacro()
shtMaster = "Master" 'The name of the summary sheet.
shtMasterFirstRowWithData = 2
Call clearMaster(shtMaster, shtMasterFirstRowWithData)
nextLinePrint = shtMasterFirstRowWithData
For Each wksht in Worksheets
If wksht.Name <> shtMaster Then
Sheets(shtMaster).Range("A" & nextLinePrint).Value = wksht.Name
c = 5
Do Until c > 12
Sheets(shtMaster).Cells(nextLinePrint, c - 3).Value = Sheets(wksht.Name).Cells(177, c).Value
c = c + 1
Loop
nextLinePrint = nextLinePrint + 1
End If
Next wksht
End Sub

Sub clearMaster(shtName, firstRow)
lastRow = Sheets(shtName).Range("A" & Rows.Count).End(xlUp).Row
lastColumn = Sheets(shtName).Cells(firstRow - 1, Columns.Count).End(xlToLeft).Column
If lastRow >= firstRow Then
Sheets(shtName).Range(Cells(firstRow, 1), Cells(lastRow, lastColumn)).ClearContents
End If
End Sub

'Create a new worksheet and cell it Master then run this code.

 

[mileijit]

That's amazing. I don't think I'd ever have been able to work that out myself!

Thank you

Are you able to help me tweak the Master sheet a bit more to -

1. Add a blank column in between the worksheet names column (currently row A) and data (currently rows B to I) so that I can manually write in a project description etc. [i.e. so it leaves the column untouched when I re-run the macro] - Otherwise, move the macro data to start at column C so I can put the project description etc. in front of it?
2. Add the text of the months on top of the cost data in rows B to I on the Master sheet (May to December in rows E3 to L3 on each worksheet) - Not essential as I can just move the macro down to start in row 3 and add them in manually, but it would be nice to have this for future reference when the months change!
3. Also, with the current code posted above, there's a cell with 'MASTER!' at the end of all the worksheet names column and zero's across the that entire row underneath the rest of the data - is there anyway to prevent this from being added?

Hope the above makes sense!

 

[WarPigl3t]

1. I could make it do what you requested but it would be in practical and I'll explain why. Each time you run the macro, it will begin by erasing everything on the master worksheet. Then it will prpulate all the data. If you put descriptions into any column, there's no guarantee that the description will match the row it originally matches before you ran the code the second time. If you are in dire need to insert descriptions then input the description into M177 of each of your other worksheets and then change the code that says Do Until c > 12 to Do Until c > 13

2. change the code that says shtMasterFirstRowWithData = 2
to
shtMasterFirstRowWithData = 3

Then change where you see
Sheets(shtMaster).Cells(nextLinePrint, c - 3).Value = Sheets(wksht.Name).Cells(177, c).Value
c = c + 1

and change it to this
Sheets(shtMaster).Cells(nextLinePrint + 1, c - 3).Value = Sheets(wksht.Name).Cells(3, c).Value
c = c + 2

3. I am not sure why its making a "Master!" text on the last row.

 

[Peter_SSs]

Are you able to help me tweak the Master sheet a bit more to -


Add a blank column in between the worksheet names column (currently row A) and data (currently rows B to I) so that I can manually write in a project description etc. [i.e. so it leaves the column untouched when I re-run the macro] -

I think that should be achievable, including re-matching the descriptions with their original project number, even if the project sheets are rearranged or new project sheets added etc.

Add the text of the months on top of the cost data in rows B to I on the Master sheet (May to December in rows E3 to L3 on each worksheet) - Not essential as I can just move the macro down to start in row 3 and add them in manually, but it would be nice to have this for future reference when the months change!

Shouldn't be a problem.

Also, with the current code posted above, there's a cell with 'MASTER!' at the end of all the worksheet names column and zero's across the that entire row underneath the rest of the data - is there anyway to prevent this from being added?

If that is still happening, I think one of two things will have happened
a) You actually have another sheet somewhere called "MASTER!" as well as one called "Master" as written in the code, or
b) The value being listed on that summary is the actual summary sheet name but in the code it is say "Master" and on the sheet tab it is say "MASTER". That is, different case.
I've addresses point b) in my code below and the upper/lower case of the name shouldn't matter.

There is one other issue with the current code (easily solved) and that is that it will error if it is run when when any sheet except "Master" is the active sheet.

There are some other issues with the code &/or your approach. For example, the code directly references row 177 for the totals. It strikes me that is a bit risky. If you have to add or remove employees from your list, that total will no longer be on row 177 so the code would need to be manually modified. Maintaining 100 or so sheets with identical row setups is something of a tricky task. I can imagine at times perhaps an employee is added but for some reason they are missed on one or more of the sheets. If this happens, your monthly totals won't even be on the same row in each sheet so the code will give incorrect results.

I may be wrong, but I suspect that the total row will have a particular description on all the sheets. In my code I've guessed "Total Monthly Cost" and that that description is in column B. Easily changed in the 'Const' lines near the start of my code. If you have such a structure that should be a more reliable way to identify the correct row to use on each sheet. If that description is missing (or mis-spelled) on any sheet then the summary with my code will show "N/A" for the costs for that project.

Anyway, after carefully checking/adjusting the 'Const' lines in the code below, I suggest that you give it a try in a copy of your workbook. If it doesn't fall over (it might ) then add some descriptions in the Master sheet, rearrange the order of a few of the project sheets and/or add/remove some of the sheets, add/remove employee(s) on some or all of the sheets etc & run the code again.

If I'm wrong with my assumption about there being a common description to identify the total row, then the code will need to be re-visited on that point. Please advise.

Option Explicit

Sub Create_Master()
  Dim aDesc As Variant, aResult As Variant, aCost As Variant
  Dim ws As Worksheet
  Dim nr As Long, i As Long, j As Long, TMCr As Long
  Dim d As Object
  
  Const sMaster As String = "Master"          '<- Name of summary sheet
  Const sTMC As String = "Total Monthly Cost" '<- Text that identifies the Total Monthly Cost row on each sheet
  Const sTMCcol As String = "B"               '<- The column the above description appears in
  Const fr As Long = 2                        '<- Row on master sheet where 1st project number should appear
  Const MnthsPerProj As Long = 8              '<- Month columns per project sheet
  Const sFirstMnthCol As String = "E"         '<- Column with the first month's data (May as you described)
  
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = vbTextCompare
  ReDim aResult(1 To Sheets.Count, 1 To MnthsPerProj + 2)
  With Sheets(sMaster)
    aDesc = .Range("A1:B" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
    For j = 1 To UBound(aDesc)
      If Len(aDesc(j, 2)) Then d(CStr(aDesc(j, 1))) = aDesc(j, 2)
    Next j
    .UsedRange.ClearContents
    .Range("A" & fr - 1).Resize(, 2).Value = Array("Project", "Description")
  End With
    For Each ws In Worksheets
      If UCase(ws.Name) <> UCase(sMaster) Then
        With ws
          If i = 0 Then Sheets(sMaster).Cells(fr - 1, "C").Resize(, MnthsPerProj).Value = ws.Range("E3").Resize(, MnthsPerProj).Value
          i = i + 1
          TMCr = 0
          On Error Resume Next
          TMCr = .Columns(sTMCcol).Find(What:=sTMC, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False).Row
          On Error GoTo 0
          If TMCr Then aCost = .Cells(TMCr, sFirstMnthCol).Resize(, MnthsPerProj).Value
          aResult(i, 1) = ws.Name
          If d.Exists(ws.Name) Then aResult(i, 2) = d.Item(ws.Name)
          For j = 1 To MnthsPerProj
            If TMCr Then
              aResult(i, 2 + j) = aCost(1, j)
            Else
              aResult(i, 2 + j) = "N/A"
            End If
          Next j
        End With
      End If
    Next ws
    Sheets(sMaster).Cells(fr, 1).Resize(i, MnthsPerProj + 2).Value = aResult
End Sub

 

[mileijit]

Hi Peter,

Thank you so much for this - it works a treat! I even tried deleting and adding staff, worksheets etc. and it functions perfectly

You were correct; I had another sheet named MASTER! which I've renamed to "Template"
- Is there anyway I could get the code to ignore this sheet?

Also, on my Master sheet, I'd like to leave a spare/blank column after all the months (currently column K) and use column L to sum up the costs for all the months from column C to J for each individual row/project.

Similarly, having a row at the bottom of all the projects (again with a spare/blank row in between the data) to show the individual monthly costs (currently in rows C to J).

Then, in the cell where the above two calculations meet or align (ie. leaving one spare/blank cell after the monthly Project Costs in column L, and leaving one spare/blank cell after the totals in the Monthly Cost row) have a Total Summary Cost of all the months combined (either using the data to sum up the costs in the Project Cost column or in the Monthly Cost row).

I had used the 'sum' function to do this, but the macro seems to delete the formulas when I run it.
Or if it's easier, are you able to get the macro to not touch these cells?


Thanks in advance for your help and all the time you've spent on this!

 

[Peter_SSs]

Hi Peter,

Thank you so much for this - it works a treat! I even tried deleting and adding staff, worksheets etc. and it functions perfectly

Great news. Thanks for letting us know.

You were correct; I had another sheet named MASTER! which I've renamed to "Template"
- Is there anyway I could get the code to ignore this sheet?

Just add this blue text (ensure upper case in the code, doesn't matter about your actual tab name upper/lower case).
[If it ends up that there is a fair few sheets to ignore, there would be a better way to do that rather than adding a whole bunch of "And" conditions]

If UCase(ws.Name) <> UCase(sMaster) And UCase(ws.Name) <> "TEMPLATE" Then

Also, on my Master sheet, I'd like to leave a spare/blank column after all the months (currently column K) and use column L to sum up the costs for all the months from column C to J for each individual row/project.

Similarly, having a row at the bottom of all the projects (again with a spare/blank row in between the data) to show the individual monthly costs (currently in rows C to J).

Then, in the cell where the above two calculations meet or align (ie. leaving one spare/blank cell after the monthly Project Costs in column L, and leaving one spare/blank cell after the totals in the Monthly Cost row) have a Total Summary Cost of all the months combined (either using the data to sum up the costs in the Project Cost column or in the Monthly Cost row).

I had used the 'sum' function to do this, but the macro seems to delete the formulas when I run it.
Or if it's easier, are you able to get the macro to not touch these cells?


Thanks in advance for your help and all the time you've spent on this!

I think it would be easier to have the code recreate these totals rather than trying to preserve them. If the number of projects and/or months change they could get over-written anyway.

Near the bottom of the code, make the replacement as shown below.

    Next ws
    <del>Sheets(sMaster).Cells(fr, 1).Resize(i, MnthsPerProj + 2).Value = aResult</del>
    With Sheets(sMaster)
      .Cells(fr, 1).Resize(i, MnthsPerProj + 2).Value = aResult
      .Cells(fr + i + 1, 2).Value = sTMC
      .Cells(fr + i + 1, 3).Resize(, MnthsPerProj).FormulaR1C1 = "=SUM(R" & fr & "C:R[-2]C)"
      .Cells(fr - 1, MnthsPerProj + 4).Value = "Total Project Cost"
      .Cells(fr, MnthsPerProj + 4).Resize(i).FormulaR1C1 = "=SUM(RC3:RC[-2])"
      .Cells(fr + i + 1, MnthsPerProj + 4).FormulaR1C1 = "=SUM(RC3:RC[-2])"
    End With
End Sub

 

[mileijit]

Hi Peter,

Thank you so much for the code. I've been playing around with it and have managed to get it working with this...

Sub Master()
Dim Rng As Range, Dn As Range, n As Long, c As Long, Ac As Long, Col As Long, Q As Variant
Dim Dic As Object, K As Variant
Set Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare


For Each Dn In Rng.Offset(, 4)
    If Not Dic.exists(Month(Dn.Value)) Then
        Dic.Add Month(Dn.Value), MonthName(Month(Dn.Value))
    End If
Next
With Application
    ReDim mray(1 To Dic.Count)
        For n = .Min(Dic.keys) To .Max(Dic.keys)
            If Dic.exists(n) Then
                c = c + 1
                mray(c) = Dic(n)
            End If
        Next n
End With
ReDim ray(1 To Rng.Count + 1, 1 To 5 + Dic.Count)
            ray(1, 1) = "Project Number": ray(1, 2) = "Project Name"
            ray(1, 3) = "Project type": ray(1, 4) = "Project status": ray(1, UBound(ray, 2)) = "Total Project Cost"
        
        For n = 5 To 5 + Dic.Count - 1
            ray(1, n) = mray(n - 4)
        Next n
 Dic.RemoveAll
 n = 1
 For Each Dn In Rng
        For Ac = 5 To UBound(ray, 2) - 1
            If Month("1-" & ray(1, Ac) & "-2000") = Month(Dn.Offset(, 4).Value) Then Col = Ac
        Next Ac
        If Not Dic.exists(Dn.Value) Then
            n = n + 1
            ray(n, Col) = Dn.Offset(, 5).Value * Dn.Offset(, 6).Value
            ray(n, 1) = Dn.Offset(, -1).Value: ray(n, 2) = Dn.Value
            ray(n, 3) = Dn.Offset(, 1).Value: ray(n, 4) = Dn.Offset(, 2).Value
            Dic.Add Dn.Value, Array(n, ray(n, Col))
        Else
            Q = Dic.Item(Dn.Value)
            Q(1) = Q(1) + Dn.Offset(, 5).Value * Dn.Offset(, 6).Value
            ray(Q(0), Col) = ray(Q(0), Col) + Dn.Offset(, 5).Value * Dn.Offset(, 6).Value
            ray(Q(0), UBound(ray, 2)) = Q(1)
            Dic.Item(Dn.Value) = Q
        End If
    Next


n = n + 1
ray(n, 1) = "Total Monthly Costs"
For Ac = 5 To UBound(ray, 2)
    For Each K In Dic.keys
        ray(n, Ac) = ray(n, Ac) + ray(Dic(K)(0), Ac)
    Next K
Next Ac


With Sheets("Master").Range("A1").Resize(n, UBound(ray, 2))
    .NumberFormat = "#,##0"
    .Value = ray
    .Columns.AutoFit
    .Borders.Weight = 2
End With


End Sub

... However, it seems to miss out calculating the 'Total Project Cost' for some rows, and I can't figure out why!

---

I also have a separate sheet ("Invoices") that has more data I'd like to pull into the "Master" sheet.

The headings are: Invoice Number / Project Branch / Project Number* / Project Name* / Project Director / Transaction Date / Fees Net Amount / Consultancy Net Amount
*These have the same details as in the list pulled to compile the Master sheet.

I'd like to include the info from Project Branch and Project Director into columns in the Master Sheet (all projects will have the same value), just like the Project Name data.

Additionally, I'd like to calculate the sum of the Fees Net Amount and Consultancy Net Amount in the same fashion as the Total Project Cost column and insert them in the "Master" too.
Note: The Fees Net Amount and Consultancy Net Amount don't need to be broken up into monthly summaries (based on the Transaction Date column), but all the rows for X project need to be added together to give the Total amounts for each project.

I hope the above makes sense, and you can help with this as well!!!

 

[mileijit]

Hi Peter,

Just wanted to let you know that I've been testing the code and it seems to work brilliantly.

Thank you once again!

 

[Peter_SSs]

Hi Peter,

Thank you so much for the code. I've been playing around with it and have managed to get it working with this...

Sub Master()
Dim Rng As Range, Dn As Range, n As Long, c As Long, Ac As Long, Col As Long, Q As Variant
Dim Dic As Object, K As Variant
Set Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
.
.
.

... However, it seems to miss out calculating the 'Total Project Cost' for some rows, and I can't figure out why!

---

I also have a separate sheet ("Invoices") .....

I hope the above makes sense, and you can help with this as well!!!

This appears to have nothing to do with my code or this thread?

Hi Peter,

Just wanted to let you know that I've been testing the code and it seems to work brilliantly.

Thank you once again!

Great news. Thanks for letting us know.