Worksheet calculations VBA

[wrightyrx7]

Hi all,

I have a workbook with with 10 worksheets.

Can anyone create a macro that will do the following on worksheet(2) to worksheet(10)

1. Autofit column widths
2.Sum columns H and I on each row into column J with the header Total
3.Change column J to VALUES

If you need anymore information please ask.

Thanks in advance
Chris

 

[Rick Rothstein]

I think this code may do what you want...

Sub CreateTotalsInColumnJ()
  Dim X As Long, LastRow As Long
  For X = 2 To 10
    With Worksheets(X)
      LastRow = .Cells(Rows.Count, "H").End(xlUp).Row
      .Range("J1").Value = "Total"
      .Range("J2:J" & LastRow).FormulaR1C1 = "=SUM(RC8:RC9)"
      Columns("J").Value = Columns("J").Value
      .Columns.AutoFit
    End With
  Next
End Sub

 

[wrightyrx7]

Hi Rick,

Thanks for the quick reply.

This works great is there any way to change column J to a value format after the sum because when this macro is run i have to calculate the totals at the bottom of columns H,I and J

It wont let me sum columns J cae its full of Sums.

Sorry to be a pain.

Thanks again
Chris

 

[HalfAce]

This should do it also. Just added a little test to make sure the user actually has 10 sheets to work with...

Dim ShtCount As Long, _
    Sht As Long, _
    LstRw As Long, _
    ThsRw As Long
    
ShtCount = ThisWorkbook.Worksheets.Count
If ShtCount < 10 Then MsgBox "You only have " & ShtCount & " sheets in this workbook." & vbNewLine & _
                             "This routine will be cancelled.": Exit Sub

For Sht = 2 To 10
  With Sheets(Sht)
    .Cells.Columns.AutoFit
    .Cells(1, "J").Value = "Total"
    LstRw = .Cells(Rows.Count, "H").End(xlUp).Row
    For ThsRw = 2 To LstRw
      .Cells(ThsRw, "J").Value = Application.WorksheetFunction.Sum(.Cells(ThsRw, "H"), .Cells(ThsRw, "I"))
    Next ThsRw
  End With
Next Sht

End Sub

However, to answer your question about Rick's code making column J fixed values, all you need to do is put a period in front of 'Columns". (Because it's inside the With statement.)
(ie.)

Sub CreateTotalsInColumnJ()
  Dim X As Long, LastRow As Long
  For X = 2 To 10
    With Worksheets(X)
      LastRow = .Cells(Rows.Count, "H").End(xlUp).Row
      .Range("J1").Value = "Total"
      .Range("J2:J" & LastRow).FormulaR1C1 = "=SUM(RC8:RC9)"
      [COLOR=Red][B].[/B][/COLOR]Columns("J").Value = [COLOR=Red][B].[/B][/COLOR]Columns("J").Value
      .Columns.AutoFit
    End With
  Next
End Sub

Hope it helps.

 

[wrightyrx7]

Thank you both they both work perfect. Dont suppose there is anything that can be added to sum each column (H,I and J) with a 1 row space at the bottom?

Thanks again, only started using/learning VBA yesterday its a very powerful thing.

 

[Rick Rothstein]

However, to answer your question about Rick's code making column J fixed values, all you need to do is put a period in front of 'Columns". (Because it's inside the With statement.)

Thanks for catch that (I'm usually more careful about leading dots inside With..End With blocks)... much appreciated.

 

[HalfAce]

Dont suppose there is anything that can be added to sum each column (H,I and J) with a 1 row space at the bottom?

Sure. For The code I posted...

Dim ShtCount As Long, _
    Sht As Long, _
    LstRw As Long, _
    ThsRw As Long
    
ShtCount = ThisWorkbook.Worksheets.Count
If ShtCount < 10 Then MsgBox "You only have " & ShtCount & " sheets in this workbook." & vbNewLine & _
                             "This routine will be cancelled.": Exit Sub

For Sht = 2 To 10
  With Sheets(Sht)
    .Cells.Columns.AutoFit
    .Cells(1, "J").Value = "Total"
    LstRw = .Cells(Rows.Count, "H").End(xlUp).Row
    For ThsRw = 2 To LstRw
      .Cells(ThsRw, "J").Value = Application.WorksheetFunction.Sum(.Cells(ThsRw, "H"), .Cells(ThsRw, "I"))
    Next ThsRw
    .Cells(LstRw + 2, "J").Value = Application.WorksheetFunction.Sum(.Range("J2:J" & LstRw))
  End With
Next Sht

Or, for the code Rick posted...

Sub CreateTotalsInColumnJ()
  Dim X As Long, LastRow As Long
  For X = 2 To 10
    With Worksheets(X)
      LastRow = .Cells(Rows.Count, "H").End(xlUp).Row
      .Range("J1").Value = "Total"
      .Range("J2:J" & LastRow).FormulaR1C1 = "=SUM(RC8:RC9)"
      .Columns("J").Value = .Columns("J").Value
      .Columns.AutoFit
      .Cells(LastRow + 2, "J").Value = Application.WorksheetFunction.Sum(.Range("J2:J" & LastRow))
    End With
  Next
End Sub

 

[Rick Rothstein]

Thank you both they both work perfect. Dont suppose there is anything that can be added to sum each column (H,I and J) with a 1 row space at the bottom?

Give this a try...

Sub CreateTotalsInColumnJ()
  Dim X As Long, LastRow As Long
  For X = 2 To 10
    With Worksheets(X)
      LastRow = .Cells(Rows.Count, "H").End(xlUp).Row
      .Range("J1").Value = "Total"
      .Range("J2:J" & LastRow).FormulaR1C1 = "=SUM(RC8:RC9)"
      .Columns("J").Value = .Columns("J").Value
      .Range("H" & (LastRow + 2) & ":J" & (LastRow + 2)).FormulaR1C1 = "=SUM(R2C:R" & LastRow & "C)"
      .Columns.AutoFit
    End With
  Next
End Sub

...only started using/learning VBA yesterday its a very powerful thing.

Yes, it is.

 

[Rick Rothstein]

Or, for the code Rick posted...

      .Columns.AutoFit
      .Cells(LastRow + 2, "J").Value = Application.WorksheetFunction.Sum(.Range("J2:J" & LastRow))

I would reverse the above two statements so that AutoFit would apply to the totals generated by the SUM formula.

 

[wrightyrx7]

Thank you both, these work perrrrrfect, you just saved me and my work mates loads of time. Really appriciate it.

Thanks again
Chris