Automatically update sheets based on input entered in another sheet

[BP Excel]

I’m looking for a way to automatically update Sheet 2 and Sheet 3 based on information entered on Sheet 1.

Sheet1 is a very simple 3-column spreadsheet used for entering data. The first column in Sheet1 is used to enter names; the second column is used to enter a number of projects associated with each name; and third column is used to enter the total hours of all projects.

Sheet1:

Name	# of Projects	# of Hours
A	2	200
B	3	300
C	0	0
D	1	100
E	0	0

<tbody>
</tbody>

Sheet 2 displays the names, projects, and hours from Sheet1 that have at least 1 project. (Number of projects is greater than 0.)

Sheet2:

Name	# of Projects	# of Hours
A	2	200
B	3	300
D	1	100

<tbody>
</tbody>

Sheet 3 displays the names from Sheet 1 that have less than 1 project. (Number of projects is 0.)

Sheet3:

Name	# of Projects	# of Hours
C	0	0
E	0	0

<tbody>
</tbody>

Is there a way to automate this so whenever any information is entered on Sheet 1, the corresponding information on both Sheet 2 and Sheet 3 is automatically updated? This seems pretty straightforward, but I have very limited experience using Excel. I’ve searched the forums and was not able to find a way to do this. Appreciate any help.

Thanks,
BP

 

[Scott T]

Just remember that you are calculating on the whole column so if you calculate how much to tip the pizza delivery driver and do not clear the cells it can cause your formula to give you bad results.

 

[BP Excel]

Not sure I follow what you are saying about how much to tip the pizza delivery driver. What do you mean by clear the cells?

Also, this method appears to prevent me from sorting the results of Sheet2 by Column B (# of Projects), then Column C (# of Hours). The data in Sheet2 is always presented in the same order as in data entry from Sheet1 regardless of the values in Column B or Column C. Is there a good way to enable me to sort with this method (other than copying the data from Sheet1 to another location, sorting that data, and then using that sorted data to populate the other Sheets)?

Thanks,
BP

 

[Scott T]

Not sure I follow what you are saying about how much to tip the pizza delivery driver. What do you mean by clear the cells?

If you do =SUM(A:A) and then use excel to do a quick calculation and do not delete it or put other data in column A it could give you the wrong result since it is now adding something you do not want.

Also, this method appears to prevent me from sorting the results of Sheet2 by Column B (# of Projects), then Column C (# of Hours). The data in Sheet2 is always presented in the same order as in data entry from Sheet1 regardless of the values in Column B or Column C. Is there a good way to enable me to sort with this method (other than copying the data from Sheet1 to another location, sorting that data, and then using that sorted data to populate the other Sheets)?

Since the other worksheets are formula that use the row number as a counter the only way I know of to sort them would be to copy and then paste them off to the side as values. You could then sort that.

The below code should do what you want and also allow you to sort the data with out having to do anything else to the data. I used Sheet1-Sheet4 If your sheets are named differently you will need to change the code to reflect the correct sheet name.

1. Total number of Names from Sheet1
2. Total number of Names from Sheet1 with at least 1 project
3. Percentage of Names with at least 1 project
4. Total number of Projects from Sheet1
5. Total number of Hours from Sheet1
The code will put this in B2:B6 except for the percentage since that is a simple calculation=IFERROR(B3/B2,"")

Sub numproj()

lr1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lr2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
lr3 = Worksheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row


Worksheets("Sheet2").Range("A2:C" & lr2).ClearContents
Worksheets("Sheet3").Range("A2:C" & lr2).ClearContents


lr2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
lr3 = Worksheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row


Worksheets("Sheet1").Activate


For i = 2 To lr1
    If Worksheets("Sheet1").Cells(i, 2) > 0 Then
        Rows(i).Copy Destination:=Sheets("Sheet2").Range("A" & lr2 + 1)
        lr2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    End If
Next i


For t = 2 To lr1
    If Worksheets("Sheet1").Cells(t, 2) = 0 Then
        Rows(t).Copy Destination:=Sheets("Sheet3").Range("A" & lr3 + 1)
        lr3 = Worksheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
    End If
Next t


Worksheets("Sheet4").Range("B2") = lr1 - 1
Worksheets("Sheet4").Range("B3") = lr2 - 1
Worksheets("Sheet4").Range("B5").Value = Application.Sum(Worksheets("Sheet1").Range(Cells(2, 2), Cells(lr1, 2)))
Worksheets("Sheet4").Range("B6").Value = Application.Sum(Worksheets("Sheet1").Range(Cells(2, 3), Cells(lr1, 3)))


End Sub

 

[Scott T]

Test on a copy of your data things done by macro cannot be undone.

Sub numproj()Application.ScreenUpdating = False 'turn of screen updateing so code runs faster
lr1 = Worksheets("Data Entry").Cells(Rows.Count, 1).End(xlUp).Row 'find last row of sheet
lr2 = Worksheets("Units Reporting Service").Cells(Rows.Count, 1).End(xlUp).Row
lr3 = Worksheets("Units Not Reporting").Cells(Rows.Count, 1).End(xlUp).Row

Worksheets("Units Reporting Service").Range("A2:E" & lr2).ClearContents 'clear the sheets so items are not duplicated
Worksheets("Units Not Reporting").Range("A2:E" & lr3).ClearContents

lr2 = Worksheets("Units Reporting Service").Cells(Rows.Count, 1).End(xlUp).Row
lr3 = Worksheets("Units Not Reporting").Cells(Rows.Count, 1).End(xlUp).Row

Worksheets("Data Entry").Activate

For i = 2 To lr1 'loop to copy rows with projects
    If Worksheets("Data Entry").Cells(i, 2) > 0 Then
        Rows(i).Copy Destination:=Sheets("Units Reporting Service").Range("A" & lr2 + 1)
        lr2 = Worksheets("Units Reporting Service").Cells(Rows.Count, 1).End(xlUp).Row
    End If
Next i

For t = 2 To lr1 'loop to copy rows without projects
    If Worksheets("Data Entry").Cells(t, 2) = 0 Then
        Rows(t).Copy Destination:=Sheets("Units Not Reporting").Range("A" & lr3 + 1)
        lr3 = Worksheets("Units Not Reporting").Cells(Rows.Count, 1).End(xlUp).Row
    End If
Next t


Sheets("Units Reporting Service").Range("D1:E" & lr2).ClearContents
Sheets("Units Reporting Service").Range("D1:E" & lr2).Interior.ColorIndex = xlNone


Worksheets("Total Service").Range("B2") = Application.WorksheetFunction.CountIf(Sheets("Data Entry").Range("B2:B" & lr1), ">0") & " of " & Application.WorksheetFunction.CountIf(Sheets("Data Entry").Range("A2:A" & lr1), "<>")
Worksheets("Total Service").Range("B3") = Application.WorksheetFunction.CountIf(Sheets("Data Entry").Range("B2:B" & lr1), ">0") / Application.WorksheetFunction.CountIf(Sheets("Data Entry").Range("A2:A" & lr1), "<>")
Worksheets("Total Service").Range("B4").Value = Application.Sum(Worksheets("Data Entry").Range(Cells(2, 2), Cells(lr1, 2)))
Worksheets("Total Service").Range("B5").Value = Application.Sum(Worksheets("Data Entry").Range(Cells(2, 3), Cells(lr1, 3)))



    ActiveWorkbook.Worksheets("Units Reporting Service").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Units Reporting Service").Sort.SortFields.Add Key _
        :=Range("B2:B" & lr2), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Units Reporting Service").Sort
        .SetRange Range("A1:C" & lr2)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


Application.ScreenUpdating = True


End Sub

You can assign the macro a short cut and use that or make a form control button to run the macro see the video below
https://youtu.be/XmOk1QW6T0g

You will need to save the workbook as a XLSM as the XLSX file type does not allow macros.

I assumed you wanted it sorted decending if not you need to change Order:=xlDescending to Order:=xlAscending

 

[Scott T]

This code should work better. Please use this instead of the above.

Sub numproj()Application.ScreenUpdating = False 'turn of screen updateing so code runs faster
lr1 = Worksheets("Data Entry").Cells(Rows.Count, 1).End(xlUp).Row 'find last row of sheet
lr2 = Worksheets("Units Reporting Service").Cells(Rows.Count, 1).End(xlUp).Row
lr3 = Worksheets("Units Not Reporting").Cells(Rows.Count, 1).End(xlUp).Row

Worksheets("Units Reporting Service").Range("A2:E" & lr2 + 1).ClearContents 'clear the sheets so items are not duplicated
Worksheets("Units Not Reporting").Range("A2:E" & lr3 + 1).ClearContents
Sheets("Units Reporting Service").Range("A2:C" & lr2 + 1).Interior.ColorIndex = xlNone
Sheets("Units Not Reporting").Range("A2:C" & lr3 + 1).Interior.ColorIndex = xlNone

lr2 = Worksheets("Units Reporting Service").Cells(Rows.Count, 1).End(xlUp).Row
lr3 = Worksheets("Units Not Reporting").Cells(Rows.Count, 1).End(xlUp).Row

Worksheets("Data Entry").Activate

For i = 2 To lr1 'loop to copy rows with projects
    If Worksheets("Data Entry").Cells(i, 2) > 0 Then
        Worksheets("Data Entry").Range("A" & i).Resize(1, 3).Copy Destination:=Sheets("Units Reporting Service").Range("A" & lr2 + 1)
        lr2 = Worksheets("Units Reporting Service").Cells(Rows.Count, 1).End(xlUp).Row
    End If
Next i

For t = 2 To lr1 'loop to copy rows without projects
    If Worksheets("Data Entry").Cells(t, 2) = 0 Then
        Worksheets("Data Entry").Range("A" & t).Resize(1, 3).Copy Destination:=Sheets("Units Not Reporting").Range("A" & lr3 + 1)
        lr3 = Worksheets("Units Not Reporting").Cells(Rows.Count, 1).End(xlUp).Row
    End If
Next t


Worksheets("Total Service").Range("B2") = Application.WorksheetFunction.CountIf(Sheets("Data Entry").Range("B2:B" & lr1), ">0") & " of " & Application.WorksheetFunction.CountIf(Sheets("Data Entry").Range("A2:A" & lr1), "<>")
Worksheets("Total Service").Range("B3") = Application.WorksheetFunction.CountIf(Sheets("Data Entry").Range("B2:B" & lr1), ">0") / Application.WorksheetFunction.CountIf(Sheets("Data Entry").Range("A2:A" & lr1), "<>")
Worksheets("Total Service").Range("B4").Value = Application.Sum(Worksheets("Data Entry").Range(Worksheets("Data Entry").Cells(2, 2), Worksheets("Data Entry").Cells(lr1, 2)))
Worksheets("Total Service").Range("B5").Value = Application.Sum(Worksheets("Data Entry").Range(Worksheets("Data Entry").Cells(2, 3), Worksheets("Data Entry").Cells(lr1, 3)))

    ActiveWorkbook.Worksheets("Units Reporting Service").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Units Reporting Service").Sort.SortFields.Add Key _
        :=Range("B2:B" & lr2), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Units Reporting Service").Sort
        .SetRange Range("A1:C" & lr2)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


Application.ScreenUpdating = True


End Sub