I have a data sheet which is populated from a form on another worksheet by
means of command button. What i would like to do is to add something to the
button code to automaticaly add a total row at the end of every week to the
data sheet.
This is the code use to populate the data sheet
Sub Button1_Click()
Dim smallrng As Range, DestRange As Range
Dim DestSheet As Worksheet, Lr As Long
Dim SourceRange As Range, I As Integer

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'fill in the Source Sheet and range
Set SourceRange =
Sheets("Sheet1").Range("H2,E5,E6,E7,E8,E9,E10,E11, E12,E13,E14,E15")

'Fill in the destination sheet and call the LastRow
'function to find the last row
Set DestSheet = Sheets("Sheet2")
Lr = LastRow(DestSheet)
I = 1

For Each smallrng In SourceRange.Areas

'We make DestRange the same size as smallrng and use the
'Value property to give DestRange the same values
With smallrng
Set DestRange = DestSheet.Cells(Lr + 1, I) _
.Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = smallrng.Value
I = I + smallrng.Columns.Count

Next smallrng

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Range("C5:D15,C18:D27").Select
Selection.ClearContents
End Sub
Any help would be much appreciated
Thanks
Tredown

There isn't enough information to determine where to add the new rows or
which columns need to be totaled. It is easier to see a sample of your data
to be able to write the code.

"Tredown" wrote:

I have a data sheet which is populated from a form on another worksheet by
means of command button. What i would like to do is to add something to the
button code to automaticaly add a total row at the end of every week to the
data sheet.
This is the code use to populate the data sheet
Sub Button1_Click()
Dim smallrng As Range, DestRange As Range
Dim DestSheet As Worksheet, Lr As Long
Dim SourceRange As Range, I As Integer

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'fill in the Source Sheet and range
Set SourceRange =
Sheets("Sheet1").Range("H2,E5,E6,E7,E8,E9,E10,E11, E12,E13,E14,E15")

'Fill in the destination sheet and call the LastRow
'function to find the last row
Set DestSheet = Sheets("Sheet2")
Lr = LastRow(DestSheet)
I = 1

For Each smallrng In SourceRange.Areas

'We make DestRange the same size as smallrng and use the
'Value property to give DestRange the same values
With smallrng
Set DestRange = DestSheet.Cells(Lr + 1, I) _
.Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = smallrng.Value
I = I + smallrng.Columns.Count

Next smallrng

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Range("C5:D15,C18:D27").Select
Selection.ClearContents
End Sub
Any help would be much appreciated
Thanks
Tredown

Hi Joel
Thanks for replying, I have columns A through to K, column A is a date, B-K
contain amounts taken for various activities, with one row is added each day.
What I am tring to achieve is to atomaticaly add a weekly total row after
each seven days with "Wk total" placed in column A and total columns B-K
If you like I could email a screen shot of the data sheet
Thanks
Tredown

"Joel" wrote:

There isn't enough information to determine where to add the new rows or
which columns need to be totaled. It is easier to see a sample of your data
to be able to write the code.

"Tredown" wrote:

I have a data sheet which is populated from a form on another worksheet by
means of command button. What i would like to do is to add something to the
button code to automaticaly add a total row at the end of every week to the
data sheet.
This is the code use to populate the data sheet
Sub Button1_Click()
Dim smallrng As Range, DestRange As Range
Dim DestSheet As Worksheet, Lr As Long
Dim SourceRange As Range, I As Integer

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'fill in the Source Sheet and range
Set SourceRange =
Sheets("Sheet1").Range("H2,E5,E6,E7,E8,E9,E10,E11, E12,E13,E14,E15")

'Fill in the destination sheet and call the LastRow
'function to find the last row
Set DestSheet = Sheets("Sheet2")
Lr = LastRow(DestSheet)
I = 1

For Each smallrng In SourceRange.Areas

'We make DestRange the same size as smallrng and use the
'Value property to give DestRange the same values
With smallrng
Set DestRange = DestSheet.Cells(Lr + 1, I) _
.Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = smallrng.Value
I = I + smallrng.Columns.Count

Next smallrng

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Range("C5:D15,C18:D27").Select
Selection.ClearContents
End Sub
Any help would be much appreciated
Thanks
Tredown

I don't know which day of the week you are considering the last day so change
the line below to the correct day of the week

Const EndofWeek = vbSaturday

The code is smart and can be run over and over as you add new rows. It
check to see if the first column contains "Wk total" before adding the new
row. It also check to see which row is the last row. If the last row is not
a complete week it doesn't add the total for the partial week.

The code create a formual in the total row to add the numbers. I think this
is better than hard coding the sum because if manual change are required to
the data the total will automatically adjust.

Sub add_totals()
Const EndofWeek = vbSaturday
StartRow = 1
RowCount = StartRow
'First Row is the row for the start of the week
FirstRow = StartRow
Do While Range("A" & RowCount) < ""
If Weekday(Range("A" & RowCount), _
vbSunday) = EndofWeek Then

If Range("A" & (RowCount + 1)) < _
"Wk total" Then

Rows(RowCount + 1).Insert
Range("A" & (RowCount + 1)) = "Wk total"
End If

For ColCount = 2 To 11 'col B to K
Cells(RowCount + 1, ColCount).FormulaR1C1 = _
"=Sum(R" & FirstRow & "C" & ColCount & _
":R" & RowCount & "C" & ColCount & ")"
Next ColCount

RowCount = RowCount + 1
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop

End Sub


"Tredown" wrote:

Hi Joel
Thanks for replying, I have columns A through to K, column A is a date, B-K
contain amounts taken for various activities, with one row is added each day.
What I am tring to achieve is to atomaticaly add a weekly total row after
each seven days with "Wk total" placed in column A and total columns B-K
If you like I could email a screen shot of the data sheet
Thanks
Tredown

"Joel" wrote:

There isn't enough information to determine where to add the new rows or
which columns need to be totaled. It is easier to see a sample of your data
to be able to write the code.

"Tredown" wrote:

I have a data sheet which is populated from a form on another worksheet by
means of command button. What i would like to do is to add something to the
button code to automaticaly add a total row at the end of every week to the
data sheet.
This is the code use to populate the data sheet
Sub Button1_Click()
Dim smallrng As Range, DestRange As Range
Dim DestSheet As Worksheet, Lr As Long
Dim SourceRange As Range, I As Integer

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'fill in the Source Sheet and range
Set SourceRange =
Sheets("Sheet1").Range("H2,E5,E6,E7,E8,E9,E10,E11, E12,E13,E14,E15")

'Fill in the destination sheet and call the LastRow
'function to find the last row
Set DestSheet = Sheets("Sheet2")
Lr = LastRow(DestSheet)
I = 1

For Each smallrng In SourceRange.Areas

'We make DestRange the same size as smallrng and use the
'Value property to give DestRange the same values
With smallrng
Set DestRange = DestSheet.Cells(Lr + 1, I) _
.Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = smallrng.Value
I = I + smallrng.Columns.Count

Next smallrng

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Range("C5:D15,C18:D27").Select
Selection.ClearContents
End Sub
Any help would be much appreciated
Thanks
Tredown

Thanks Joel
I have tried your sub but I get a run-time error '13': type mismatch on the
following line of code
If Weekday(Range("A" & RowCount), _
vbSunday) = EndofWeek Then
any sugestions

Tredown

"Joel" wrote:

I don't know which day of the week you are considering the last day so change
the line below to the correct day of the week

Const EndofWeek = vbSaturday

The code is smart and can be run over and over as you add new rows. It
check to see if the first column contains "Wk total" before adding the new
row. It also check to see which row is the last row. If the last row is not
a complete week it doesn't add the total for the partial week.

The code create a formual in the total row to add the numbers. I think this
is better than hard coding the sum because if manual change are required to
the data the total will automatically adjust.

Sub add_totals()
Const EndofWeek = vbSaturday
StartRow = 1
RowCount = StartRow
'First Row is the row for the start of the week
FirstRow = StartRow
Do While Range("A" & RowCount) < ""
If Weekday(Range("A" & RowCount), _
vbSunday) = EndofWeek Then

If Range("A" & (RowCount + 1)) < _
"Wk total" Then

Rows(RowCount + 1).Insert
Range("A" & (RowCount + 1)) = "Wk total"
End If

For ColCount = 2 To 11 'col B to K
Cells(RowCount + 1, ColCount).FormulaR1C1 = _
"=Sum(R" & FirstRow & "C" & ColCount & _
":R" & RowCount & "C" & ColCount & ")"
Next ColCount

RowCount = RowCount + 1
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop

End Sub


"Tredown" wrote:

Hi Joel
Thanks for replying, I have columns A through to K, column A is a date, B-K
contain amounts taken for various activities, with one row is added each day.
What I am tring to achieve is to atomaticaly add a weekly total row after
each seven days with "Wk total" placed in column A and total columns B-K
If you like I could email a screen shot of the data sheet
Thanks
Tredown

"Joel" wrote:

There isn't enough information to determine where to add the new rows or
which columns need to be totaled. It is easier to see a sample of your data
to be able to write the code.

"Tredown" wrote:

I have a data sheet which is populated from a form on another worksheet by
means of command button. What i would like to do is to add something to the
button code to automaticaly add a total row at the end of every week to the
data sheet.
This is the code use to populate the data sheet
Sub Button1_Click()
Dim smallrng As Range, DestRange As Range
Dim DestSheet As Worksheet, Lr As Long
Dim SourceRange As Range, I As Integer

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'fill in the Source Sheet and range
Set SourceRange =
Sheets("Sheet1").Range("H2,E5,E6,E7,E8,E9,E10,E11, E12,E13,E14,E15")

'Fill in the destination sheet and call the LastRow
'function to find the last row
Set DestSheet = Sheets("Sheet2")
Lr = LastRow(DestSheet)
I = 1

For Each smallrng In SourceRange.Areas

'We make DestRange the same size as smallrng and use the
'Value property to give DestRange the same values
With smallrng
Set DestRange = DestSheet.Cells(Lr + 1, I) _
.Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = smallrng.Value
I = I + smallrng.Columns.Count

Next smallrng

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Range("C5:D15,C18:D27").Select
Selection.ClearContents
End Sub
Any help would be much appreciated
Thanks
Tredown

You Column A data is not in a Serial Date format ( microsoft terms for its
date format). You need to either ned to do the following

1) Convert the worksheet data to date format (it is probably a string)
2) Convert the string to a date in the VBA code.

from
If Weekday(Range("A" & RowCount), _
vbSunday) = EndofWeek Then
to
If Weekday(datevalue(Range("A" & RowCount)), _
vbSunday) = EndofWeek Then

3) You you have some other non datae format in your worksheeet. The code
expects a date to start in Row 1. If you have a header row then change the
collowing line of code

from
StartRow = 1
to
StartRow = 2

"Tredown" wrote:

Thanks Joel
I have tried your sub but I get a run-time error '13': type mismatch on the
following line of code
If Weekday(Range("A" & RowCount), _
vbSunday) = EndofWeek Then
any sugestions

Tredown

"Joel" wrote:

I don't know which day of the week you are considering the last day so change
the line below to the correct day of the week

Const EndofWeek = vbSaturday

The code is smart and can be run over and over as you add new rows. It
check to see if the first column contains "Wk total" before adding the new
row. It also check to see which row is the last row. If the last row is not
a complete week it doesn't add the total for the partial week.

The code create a formual in the total row to add the numbers. I think this
is better than hard coding the sum because if manual change are required to
the data the total will automatically adjust.

Sub add_totals()
Const EndofWeek = vbSaturday
StartRow = 1
RowCount = StartRow
'First Row is the row for the start of the week
FirstRow = StartRow
Do While Range("A" & RowCount) < ""
If Weekday(Range("A" & RowCount), _
vbSunday) = EndofWeek Then

If Range("A" & (RowCount + 1)) < _
"Wk total" Then

Rows(RowCount + 1).Insert
Range("A" & (RowCount + 1)) = "Wk total"
End If

For ColCount = 2 To 11 'col B to K
Cells(RowCount + 1, ColCount).FormulaR1C1 = _
"=Sum(R" & FirstRow & "C" & ColCount & _
":R" & RowCount & "C" & ColCount & ")"
Next ColCount

RowCount = RowCount + 1
FirstRow = RowCount + 1
End If
RowCount = RowCount + 1
Loop

End Sub


"Tredown" wrote:

Hi Joel
Thanks for replying, I have columns A through to K, column A is a date, B-K
contain amounts taken for various activities, with one row is added each day.
What I am tring to achieve is to atomaticaly add a weekly total row after
each seven days with "Wk total" placed in column A and total columns B-K
If you like I could email a screen shot of the data sheet
Thanks
Tredown

"Joel" wrote:

There isn't enough information to determine where to add the new rows or
which columns need to be totaled. It is easier to see a sample of your data
to be able to write the code.

"Tredown" wrote:

I have a data sheet which is populated from a form on another worksheet by
means of command button. What i would like to do is to add something to the
button code to automaticaly add a total row at the end of every week to the
data sheet.
This is the code use to populate the data sheet
Sub Button1_Click()
Dim smallrng As Range, DestRange As Range
Dim DestSheet As Worksheet, Lr As Long
Dim SourceRange As Range, I As Integer

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'fill in the Source Sheet and range
Set SourceRange =
Sheets("Sheet1").Range("H2,E5,E6,E7,E8,E9,E10,E11, E12,E13,E14,E15")

'Fill in the destination sheet and call the LastRow
'function to find the last row
Set DestSheet = Sheets("Sheet2")
Lr = LastRow(DestSheet)
I = 1

For Each smallrng In SourceRange.Areas

'We make DestRange the same size as smallrng and use the
'Value property to give DestRange the same values
With smallrng
Set DestRange = DestSheet.Cells(Lr + 1, I) _
.Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = smallrng.Value
I = I + smallrng.Columns.Count

Next smallrng

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Range("C5:D15,C18:D27").Select
Selection.ClearContents
End Sub
Any help would be much appreciated
Thanks
Tredown