Select rows of data and total some columns

W

windwardmi

Board Regular
Joined
Oct 18, 2009
Messages
138
I have the following VBA code that works most of the way:
Code: 
Sub TimeSheet()
'
' TimeSheet Macro
'
' Keyboard Shortcut: Ctrl+t
'

Dim WS As Worksheet
Dim rightsheet As String
Dim StartDate As Date, EndDate As Date

StartDate = Application.InputBox("Start Date?")
EndDate = Application.InputBox("End Date?")
'ActiveSheet.PageSetup.CenterHeader = "&12" & rightsheet & Chr(10) & ActiveSheet.Name & Chr(13) & rightsheet & Chr(10) & (StartDate) & " To " & (EndDate)
ActiveSheet.PageSetup.RightHeader = "&12" & Chr(13) & rightsheet & Chr(10) & (StartDate) & " To " & (EndDate)

rightsheet = Application.InputBox("Employee Last Name?")
 
Sheets(rightsheet).Select

ActiveSheet.Range("$A$1").CurrentRegion.AutoFilter Field:=1, Criteria1:=">=" & CLng(StartDate), _
    Operator:=xlAnd, Criteria2:="<=" & CLng(EndDate)

   
Sub TimeSheet()
'
' TimeSheet Macro
'
' Keyboard Shortcut: Ctrl+t
'

Dim WS As Worksheet
Dim rightsheet As String
Dim StartDate As Date, EndDate As Date

StartDate = Application.InputBox("Start Date?")
EndDate = Application.InputBox("End Date?")
'ActiveSheet.PageSetup.CenterHeader = "&12" & rightsheet & Chr(10) & ActiveSheet.Name & Chr(13) & rightsheet & Chr(10) & (StartDate) & " To " & (EndDate)
ActiveSheet.PageSetup.RightHeader = "&12" & Chr(13) & rightsheet & Chr(10) & (StartDate) & " To " & (EndDate)

rightsheet = Application.InputBox("Employee Last Name?")
 
Sheets(rightsheet).Select

ActiveSheet.Range("$A$1").CurrentRegion.AutoFilter Field:=1, Criteria1:=">=" & CLng(StartDate), _
    Operator:=xlAnd, Criteria2:="<=" & CLng(EndDate)

    Range("E65536").End(xlUp).Offset(2, 0).Value = "TOTAL"
    
    Range("I65536").End(xlUp).Offset(2, 0).Value = _
        WorksheetFunction.Sum(Range("I2:I" & Cells.SpecialCells(xlLastCell).Row))
    Range("j65536").End(xlUp).Offset(2, 0).Value = _
        WorksheetFunction.Sum(Range("j2:j" & Cells.SpecialCells(xlLastCell).Row))
 
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
'IgnorePrintAreas:=False
End Sub

This part of the code does not work. Why is that? It works by itself in a separate procedure. What am I missing.
Code: 
    Range("E65536").End(xlUp).Offset(2, 0).Value = "TOTAL"
    
    Range("I65536").End(xlUp).Offset(2, 0).Value = _
        WorksheetFunction.Sum(Range("I2:I" & Cells.SpecialCells(xlLastCell).Row))
    Range("j65536").End(xlUp).Offset(2, 0).Value = _
        WorksheetFunction.Sum(Range("j2:j" & Cells.SpecialCells(xlLastCell).Row))
 
Sort by date Sort by votes
I just tested both your original code and the code I posted and they both put the data in the same place depending on what cells are filtered.

As this is the case try...

Code: 
Sub TimeSheet()
    '
    ' TimeSheet Macro
    '
    ' Keyboard Shortcut: Ctrl+t
    '

    Dim WS As Worksheet
    Dim rightsheet As String, LR as Long
    Dim StartDate As Date, EndDate As Date

    StartDate = Application.InputBox("Start Date?")
    EndDate = Application.InputBox("End Date?")
    'ActiveSheet.PageSetup.CenterHeader = "&12" & rightsheet & Chr(10) & ActiveSheet.Name & Chr(13) & rightsheet & Chr(10) & (StartDate) & " To " & (EndDate)
    ActiveSheet.PageSetup.RightHeader = "&12" & Chr(13) & rightsheet & Chr(10) & (StartDate) & " To " & (EndDate)

    rightsheet = Application.InputBox("Employee Last Name?")

    Sheets(rightsheet).Select

    ActiveSheet.Range("$A$1").CurrentRegion.AutoFilter Field:=1, Criteria1:=">=" & CLng(StartDate), _
                                                       Operator:=xlAnd, Criteria2:="<=" & CLng(EndDate)

    LR = Columns(5).SpecialCells(xlLastCell).Row
    
    Range("E" & LR).Offset(2, 0).Value = "TOTAL"

    Range("I" & LR).Offset(2, 0).Value = _
    WorksheetFunction.Subtotal(109, Range("I2:I" & Cells.SpecialCells(xlLastCell).Row))
    Range("J" & LR).End(xlUp).Offset(2, 0).Value = _
    WorksheetFunction.Subtotal(109, Range("J2:J" & Cells.SpecialCells(xlLastCell).Row))

    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
                                         IgnorePrintAreas:=False
End Sub
 
Last edited:
Upvote 0

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Oops sorry, try the below


Code: 
Sub TimeSheet()
    '
    ' TimeSheet Macro
    '
    ' Keyboard Shortcut: Ctrl+t
    '

    Dim WS As Worksheet, x as Long
    Dim rightsheet As String, LR as Long
    Dim StartDate As Date, EndDate As Date

    StartDate = Application.InputBox("Start Date?")
    EndDate = Application.InputBox("End Date?")
    'ActiveSheet.PageSetup.CenterHeader = "&12" & rightsheet & Chr(10) & ActiveSheet.Name & Chr(13) & rightsheet & Chr(10) & (StartDate) & " To " & (EndDate)
    ActiveSheet.PageSetup.RightHeader = "&12" & Chr(13) & rightsheet & Chr(10) & (StartDate) & " To " & (EndDate)

    rightsheet = Application.InputBox("Employee Last Name?")

    Sheets(rightsheet).Select

    ActiveSheet.Range("$A$1").CurrentRegion.AutoFilter Field:=1, Criteria1:=">=" & CLng(StartDate), _
                                                       Operator:=xlAnd, Criteria2:="<=" & CLng(EndDate)
     x =  ActiveSheet.UsedRange.Rows.Count
    LR = Columns(5).SpecialCells(xlLastCell).Row
    
    Range("E" & LR).Offset(2, 0).Value = "TOTAL"

    Range("I" & LR).Offset(2, 0).Value = _
    WorksheetFunction.Subtotal(109, Range("I2:I" & Cells.SpecialCells(xlLastCell).Row))
    Range("J" & LR).Offset(2, 0).Value = _
    WorksheetFunction.Subtotal(109, Range("J2:J" & Cells.SpecialCells(xlLastCell).Row))

    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
                                         IgnorePrintAreas:=False
End Sub
 
Last edited:
Upvote 0
Bad day today, you will have to determine the last row before the Autofilter is applied.

Code: 
Sub TimeSheet()
    '
    ' TimeSheet Macro
    '
    ' Keyboard Shortcut: Ctrl+t
    '

    Dim WS As Worksheet, x As Long
    Dim rightsheet As String, LR As Long
    Dim StartDate As Date, EndDate As Date

    StartDate = Application.InputBox("Start Date?")
    EndDate = Application.InputBox("End Date?")
    'ActiveSheet.PageSetup.CenterHeader = "&12" & rightsheet & Chr(10) & ActiveSheet.Name & Chr(13) & rightsheet & Chr(10) & (StartDate) & " To " & (EndDate)
    ActiveSheet.PageSetup.RightHeader = "&12" & Chr(13) & rightsheet & Chr(10) & (StartDate) & " To " & (EndDate)

    rightsheet = Application.InputBox("Employee Last Name?")

    Sheets(rightsheet).Select

    If ActiveSheet.AutoFilterMode = True And ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
    x = ActiveSheet.UsedRange.Rows.Count
    LR = Columns(5).SpecialCells(xlLastCell).Row

    ActiveSheet.Range("$A$1").CurrentRegion.AutoFilter Field:=1, Criteria1:=">=" & CLng(StartDate), _
                                                       Operator:=xlAnd, Criteria2:="<=" & CLng(EndDate)
  
    
    Range("E" & LR).Offset(2, 0).Value = "TOTAL"

    Range("I" & LR).Offset(2, 0).Value = _
    WorksheetFunction.Subtotal(109, Range("I2:I" & Cells.SpecialCells(xlLastCell).Row))
    Range("J" & LR).Offset(2, 0).Value = _
    WorksheetFunction.Subtotal(109, Range("J2:J" & Cells.SpecialCells(xlLastCell).Row))

    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
                                         IgnorePrintAreas:=False
End Sub
 
Upvote 0
I changed the WorksheetFunction No. 109 to 9 and it works however It does not always place the "SUBTOTAL" and results in the row 2 below the rows of data pulled by AutoFilter.

Please explain why 109 was used and how I can correct the placement of the subtotal line?

Thank you.


Code: 
Sub TimeSheet()
'
' TimeSheet Macro
'
' Keyboard Shortcut: Ctrl+t
'

Dim WS As Worksheet
Dim rightsheet As String
Dim StartDate As Date, EndDate As Date

StartDate = Application.InputBox("Start Date?")
EndDate = Application.InputBox("End Date?")
'ActiveSheet.PageSetup.CenterHeader = "&12" & rightsheet & Chr(10) & ActiveSheet.Name & Chr(13) & rightsheet & Chr(10) & (StartDate) & " To " & (EndDate)
ActiveSheet.PageSetup.RightHeader = "&12" & Chr(13) & rightsheet & Chr(10) & (StartDate) & " To " & (EndDate)

rightsheet = Application.InputBox("Employee Last Name?")
 
Sheets(rightsheet).Select

ActiveSheet.Range("$A$1").CurrentRegion.AutoFilter Field:=1, Criteria1:=">=" & CLng(StartDate), _
    Operator:=xlAnd, Criteria2:="<=" & CLng(EndDate)
    Range("E" & Rows.Count).End(xlUp).Offset(2, 0).Value = "SUBTOTAL"
    
    Range("I" & Rows.Count).End(xlUp).Offset(2, 0).Value = _
        WorksheetFunction.Subtotal(9, Range("I2:I" & Range("I" & Rows.Count).End(xlUp).Row))
    Range("J" & Rows.Count).End(xlUp).Offset(2, 0).Value = _
        WorksheetFunction.Subtotal(9, Range("J2:J" & Range("J" & Rows.Count).End(xlUp).Row))

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End Sub
 
Upvote 0
Just realized I did not see your last few posts. Your last code asked for the range then stop after that.

I'm starting to get lost here...
 
Upvote 0
Last edited:
Upvote 0
I guess I should not try to code New Years eve and New Years day. Let me get back after the Celebrations. FYI Ctl+t asked for range not the code we are working on. I had another workbook opened. Sorry...... Good night...

Thanks for all your help.. I will post link soon, when I figure that out.
 
Upvote 0
Looks like we got it working ok for now using your last code revisions pasted in its entirety. I had to change the following (2, 0) to (-1, 0) in the code to get total on 2nd line below column noted and summed.

Code: 
Range("E" & Rows.Count).End(xlUp).Offset(2, 0).Value = "SUBTOTAL"
    
    Range("I" & Rows.Count).End(xlUp).Offset(2, 0).Value = _
        WorksheetFunction.Subtotal(9, Range("I2:I" & Range("I" & Rows.Count).End(xlUp).Row))
    Range("J" & Rows.Count).End(xlUp).Offset(2, 0).Value = _
        WorksheetFunction.Subtotal(9, Range("J2:J" & Range("J" & Rows.Count).End(xlUp).Row))

to

Code: 
 Range("E" & LR).Offset(-1, 0).Value = "TOTAL"
    Range("I" & LR).Offset(-1, 0).Value = _
    WorksheetFunction.Subtotal(109, Range("I2:I" & Cells.SpecialCells(xlLastCell).Row))
    Range("J" & LR).Offset(-1, 0).Value = _
    WorksheetFunction.Subtotal(109, Range("J2:J" & Cells.SpecialCells(xlLastCell).Row))

Also I hade to assign the Option Ctrl+t to start running the Macro.

I will build on this and see where it gets to.

Ultimately I want to create a workbook for my employees to collaborate on Office 365 - OneDrive.

Thank you for the help and putting up with my lack of knowledge.
 
Upvote 0
I had to change the following (2, 0) to (-1, 0) in the code to get total on 2nd line below column noted and summed.
Click to expand...

If this is the case what is the line
Code: 
LR = Columns(5).SpecialCells(xlLastCell).Row
picking up that is 3 rows below the data to be filtered that we haven't been told about?
 
Upvote 0
Further to my last question if what it is picking up isn't in column E what happens with the code below?

Code: 
Sub TimeSheetx()
    '
    ' TimeSheet Macro
    '
    ' Keyboard Shortcut: Ctrl+t
    '

    Dim WS As Worksheet
    Dim rightsheet As String, LR As Long
    Dim StartDate As Date, EndDate As Date

    StartDate = Application.InputBox("Start Date?")
    EndDate = Application.InputBox("End Date?")
    'ActiveSheet.PageSetup.CenterHeader = "&12" & rightsheet & Chr(10) & ActiveSheet.Name & Chr(13) & rightsheet & Chr(10) & (StartDate) & " To " & (EndDate)
    ActiveSheet.PageSetup.RightHeader = "&12" & Chr(13) & rightsheet & Chr(10) & (StartDate) & " To " & (EndDate)

    rightsheet = Application.InputBox("Employee Last Name?")

    Sheets(rightsheet).Select
    
    If ActiveSheet.AutoFilterMode = True And ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
  
    LR = Columns(5).Find("*", , xlValues, xlPart, xlByRows, xlPrevious, False).Row

    ActiveSheet.Range("$A$1").CurrentRegion.AutoFilter Field:=1, Criteria1:=">=" & CLng(StartDate), _
                                                       Operator:=xlAnd, Criteria2:="<=" & CLng(EndDate)
  
    
    Range("E" & LR).Offset(2, 0).Value = "TOTAL"

    Range("I" & LR).Offset(2, 0).Value = _
    WorksheetFunction.Subtotal(109, Range("I2:I" & Cells.SpecialCells(xlLastCell).Row))
    Range("J" & LR).Offset(2, 0).Value = _
    WorksheetFunction.Subtotal(109, Range("J2:J" & Cells.SpecialCells(xlLastCell).Row))

    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
                                         IgnorePrintAreas:=False
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
Problems filtering a Pivot Table with VBA
Replies
2
Views
232
Domenic
D
V
  • Question
Excel VBA - How to modify my code to include a command that prints data to PDF
Replies
1
Views
139
VanGirl
V
S
  • Solved
Need value to be the Table Column Header in lieu of Cell Address
Replies
1
Views
289
sspatriots
S
E
  • Solved
Search by Date VBA code help
2
Replies
18
Views
1K
Fluff
Fluff
S
  • Solved
Need to have Worksheet_Change event include value from another column using structured reference
Replies
4
Views
313
Alex Blakenburg
A

Forum statistics

Threads
1,215,510
Messages
6,125,228
Members
449,216
Latest member
biglake87

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top