Calculate sum and insert text in multiple sheets

**timtim89** · 01-26-2012, 07:38 AM

Hi!

In all the sheets in the workbook I need to check column F for containing a cell of value "Commission". If it does, the numbers in the cells of the column following "Commission" needs to be summed together and the sum is insertet in the first blank cell following the numbers that are summed.
Also, if the sum is calculated, in column A I need insertet a text two rows following last cell containing value. It is better shown in the attached workbook. The code is as follows (but not working):

Public Sub Workbook_1()

For Each sh In ActiveWorkbook.Sheets

    With sh
        
        If IsError(Lookup("Commission", f)) = True Then Next sh
           
        Else: Range(Lookup("Commission", f), .Cells(Rows.Count, "f").End(xlUp)).Select
        
        Sum = Sum(Selection.Value)
        
            .Range(, .Cells(Rows.Count, "f").Offset(1, 0)) = Sum
                
        Range(Cells(Rows.Count, "a").End(xlUp).Row).Select
        Selection.Offset(2, 0).Value = "Insert text"
        
        End If
        
    End With

Next sh

End Sub

Any help is appreciated! Thanks in advance.

**arlu1201** · 01-27-2012, 08:12 AM

Put this code in a blank module of your file (Press Alt + F11, a code window will open. On the left hand side, you will see Microsoft Excel Objects, right click and select Insert -> Module. Copy this code there)

Option Explicit
Dim fcell As Range
Dim lrow As Long
Dim fcomm As Long
Dim i As Long

Sub sum_text()

For i = 1 To Worksheets.Count
    With Worksheets(i)
        Set fcell = .Range("F:F").Find(what:="Commission")
        fcomm = fcell.Row
        lrow = .Range("F" & Rows.Count).End(xlUp).Row

        .Range("F" & lrow + 1).Value = Application.WorksheetFunction.Sum(.Range("F" & fcomm + 1 & ":F" & lrow).Value)
        .Range("A" & lrow + 2).Value = "Insert Text"
    End With
Next i

End Sub

**timtim89** · 01-27-2012, 10:25 AM

Hey Arlette. Thank you so much for the code.
In the workbook in which I'll use the code I have additional sheets, in which there is no "Commission" found. I got an error message, and added

On Error Resume Next

but this does that the text (and sometimes sum) are inserted anyway in the sheets. How do I avoid this? That the text and sum are not inserted in sheets in which "Commission" is not found? My bad for the attachment no corresponding to the real data, and thanks again!

**arlu1201** · 01-28-2012, 01:06 PM

Change On Error Resume Next to On Error goto errhandler and then before next i put this line Errhandler:

**timtim89** · 01-28-2012, 01:17 PM

Thank you. It works perfect now

**timtim89** · 01-30-2012, 05:30 AM

Now that I'm applying the macro on the data that I actually need it for, I get an run time error 91 saying "Object variable or With block variable not set". This I got after adding a sheet to the workbook in which the data worked. The macro still works as supposed to, but anyone who can tell me how to get rid of the error message? I attached the workbook once again with the new data and code. Any help is appreciated, and once again: thanks a lot in advance

Option Explicit

Sub sum_text1()

Dim fcell As Range
Dim lrow As Long
Dim fcomm As Long
Dim i As Long

For i = 1 To Worksheets.Count
    With Worksheets(i)
    On Error GoTo Errhandler
        Set fcell = .Range("F:F").Find(what:="Commission")
        fcomm = fcell.Row 'here i get the error ("Object variable or With block variable not set")
        lrow = .Range("F" & Rows.Count).End(xlUp).Row

        .Range("F" & lrow + 1).Value = Application.WorksheetFunction.Sum(.Range("F" & fcomm + 1 & ":F" & lrow).Value)
        .Range("A" & lrow + 2).Value = "Insert Text"
    End With
Errhandler:
Next i

End Sub

**timtim89** · 02-05-2012, 11:34 AM

If it helps in any way, I'm also getting the error message if I simply add an empty sheet to the first three sheets (for which the code works).

**OnErrorGoto0** · 02-08-2012, 09:10 AM

That is not how you use an error handler, but you don't need one here anyway

Sub sum_text()

For i = 1 To Worksheets.Count
    With Worksheets(i)
        Set fcell = .Range("F:F").Find(what:="Commission")
        if not fcell is nothing then
        fcomm = fcell.Row
        lrow = .Range("F" & Rows.Count).End(xlUp).Row

        .Range("F" & lrow + 1).Value = Application.WorksheetFunction.Sum(.Range("F" & fcomm + 1 & ":F" & lrow).Value)
        .Range("A" & lrow + 2).Value = "Insert Text"
        end if
    End With
Next i

End Sub

**dangelor** · 02-08-2012, 09:13 AM

Try handling the errors this way...

Sub sum_text1()

    Dim fcell As Range
    Dim lrow As Long
    Dim fcomm As Long
    Dim i As Long

    For i = 1 To Worksheets.Count
        With Worksheets(i)
            Set fcell = .Range("F:F").Find(what:="Commission")
            If Not fcell Is Nothing Then
                fcomm = fcell.Row
                lrow = .Range("F" & Rows.Count).End(xlUp).Row
                .Range("F" & lrow + 1).Value = Application.WorksheetFunction.Sum(.Range("F" & fcomm + 1 & ":F" & lrow).Value)
                .Range("A" & lrow + 2).Value = "Insert Text"
            End If
        End With
    Next i

End Sub