VBA to find blank cell and insert sum when cells contain formulas

Lobsterboy1

Board Regular
Joined
Aug 5, 2016
Messages
90
Hi, I am pretty new to vba but I have picked up a lot from this forum. I am trying to write a code that finds the blank cells in a column "Q" and inserts the sum function for the cells above it and the same rows but one column to the right "R" . It will then work down the sheet continuing until the end of the filled cells which change daily. The problem is the cells in "Q" contain a formula which so in Q4 the formula would be =IF(P4="NO",E4,""). I have found and adapted some code that works on another column "E" but these cells just contain numbers which is
Code:
Sub Macro20()Dim aArea As Range
For Each aArea In Columns("E").SpecialCells(xlCellTypeConstants).Areas
    Cells(aArea.Row + aArea.Rows.Count, 5).Value = WorksheetFunction.Sum(Range(Cells(aArea.Row, 5), Cells(aArea.Row + aArea.Rows.Count - 1, 5)))
Next aArea
End Sub
[code/]

Any help would be much appricated :).
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG06Aug16
 [COLOR="Navy"]Dim[/COLOR] aArea [COLOR="Navy"]As[/COLOR] Range
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] aArea [COLOR="Navy"]In[/COLOR] Columns("Q").SpecialCells(xlCellTypeFormulas).Areas
    Cells(aArea.Row + aArea.Rows.Count, 17).Value = _
    WorksheetFunction.Sum(Range(Cells(aArea.Row, 17), Cells(aArea.Row + aArea.Rows.Count - 1, 17)))
 [COLOR="Navy"]Next[/COLOR] aArea
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Cheers Mick, that works but does not add in the numbers in column "R" to the total. Also I have been trying to get the macro to run whenever a value in column "P" is changed to "YES" from a drop down list using data validation. Here is what I have written but I keep getting an error saying "Block if without end if" but I have used end if before end sub.
Code:
Private Sub worksheet_change(ByVal target As Range)
    If target = Range("P4") Then
    If InStr(1, Range("P4"), "YES") > 0 Then
    Call Macro22
End If


End Sub

Cheers for your help.
 
Upvote 0
As I cant edit posts yet I should have said I was trying to get this to work just on cell P4 before I try for the entire P column.

Cheers
 
Upvote 0
Try this:-
This code assumes that any Blank cells in "Q" is because you have a "No" in column "P" (i.e) the Blank cell still contains the formula)
code runs when you change value in "P".
Code:
Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Temp [COLOR="Navy"]As[/COLOR] Double, Tot [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("Q4"), Range("Q" & Rows.Count).End(xlUp))
  [COLOR="Navy"]If[/COLOR] Target.Column = 16 And Target.Count = 1 [COLOR="Navy"]Then[/COLOR]
    Range("R:R").ClearContents
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] Dn.Value = "" [COLOR="Navy"]Then[/COLOR]
                Dn.Offset(, 1) = Temp: Temp = 0
            [COLOR="Navy"]Else[/COLOR]
                Tot = Tot + Temp
            Temp = Temp + Dn.Value
            [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
Rng(Rng.Count).Offset(1, 1) = Temp
Rng(Rng.Count).Offset(2, 1) = "Tot= " & Application.Sum(Rng)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Cheers Mick this works but I am having to rethink my sheet altogether now. I currently have a "MASTER" sheet with all my data, I then run a macro that copys the "MASTER" sheet renames it and filters by the value in column "D" and deletes the rows not needed, it then looks for date changes in column "A" and inserts a blank row at the date change, sums column "E" when there is a blank row, and the code you have written does column "Q,R". If i insert your code once the first macro has been run it works fine, but if I insert it into the "MASTER" sheet when I run the macro I get an error on the underlined line.
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Dn As Range, Temp As Double, Tot As Double
Set Rng = Range(Range("Q4"), Range("Q" & Rows.Count).End(xlUp))
  If Target.Column = 16 And Target.Count = 1 Then
    Range("R:R").ClearContents
        For Each Dn In Rng
            If Dn.Value = "" Then
                Dn.Offset(, 1) = Temp: Temp = 0
            Else
                Tot = Tot + Temp
            Temp = Temp + Dn.Value
            End If
    Next Dn
Rng(Rng.Count).Offset(1, 1) = Temp
Rng(Rng.Count).Offset(2, 1) = "Tot= " & Application.Sum(Rng)
End If
End Sub

I think this is to do with your code running before my macro has put a blank row in but I could be wrong.

MASTER

*ABCDEFGHIJKLMNOPQR
3DELBATCHTYPELINEQTY**********BATCH RUNQTYLEFT
410-Aug**BOB60**********NO60*
510-Aug**BOB60**********NO60*
610-Aug**MICK50**********NO50*
710-Aug**MICK45**********NO45*
810-Aug**BOB60**********NO60*
910-Aug**MICK60**********NO60*
1011-Aug**BOB45**********NO45*
1111-Aug**MICK25**********NO25*
1211-Aug**BOB35**********NO35*
1311-Aug**MICK12**********NO12*
1411-Aug**BOB60**********NO60*
1511-Aug**MICK60**********NO60*
1612-Aug**BOB52**********NO52*
1712-Aug**BOB25**********NO25*
1812-Aug**BOB15**********NO15*
1912-Aug**MICK63**********NO63*
2012-Aug**MICK21**********NO21*
2112-Aug**MICK52**********NO52*

<tbody>
</tbody>

Spreadsheet Formulas
CellFormula
Q4=IF(P4="NO",E4,"")
Q5=IF(P5="NO",E5,"")
Q6=IF(P6="NO",E6,"")
Q7=IF(P7="NO",E7,"")
Q8=IF(P8="NO",E8,"")
Q9=IF(P9="NO",E9,"")
Q10=IF(P10="NO",E10,"")
Q11=IF(P11="NO",E11,"")
Q12=IF(P12="NO",E12,"")
Q13=IF(P13="NO",E13,"")
Q14=IF(P14="NO",E14,"")
Q15=IF(P15="NO",E15,"")
Q16=IF(P16="NO",E16,"")
Q17=IF(P17="NO",E17,"")
Q18=IF(P18="NO",E18,"")
Q19=IF(P19="NO",E19,"")
Q20=IF(P20="NO",E20,"")
Q21=IF(P21="NO",E21,"")

<tbody>
</tbody>

<tbody>
</tbody>


BOB

*ABCDEFGHIJKLMNOPQR
3DELBATCHTYPELINEQTY**********BATCH RUNQTY*
410-Aug**BOB60**********NO60*
510-Aug**BOB60**********NO60*
610-Aug**BOB60**********NO60*
7****180***********180*
811-Aug**BOB45**********NO45*
911-Aug**BOB35**********NO35*
1011-Aug**BOB60**********NO60*
11****140***********140*
1212-Aug**BOB52**********NO52*
1312-Aug**BOB25**********NO25*
1412-Aug**BOB15**********NO15*
15****92***********92*

<tbody>
</tbody>

Spreadsheet Formulas
CellFormula
Q4=IF(P4="NO",E4,"")
Q5=IF(P5="NO",E5,"")
Q6=IF(P6="NO",E6,"")
E7=SUM(E4:E6)
Q7=SUM(Q4:R6)
Q8=IF(P8="NO",E8,"")
Q9=IF(P9="NO",E9,"")
Q10=IF(P10="NO",E10,"")
E11=SUM(E8:E10)
Q11=SUM(Q8:R10)
Q12=IF(P12="NO",E12,"")
Q13=IF(P13="NO",E13,"")
Q14=IF(P14="NO",E14,"")
E15=SUM(E12:E14)
Q15=SUM(Q12:R14)

<tbody>
</tbody>

<tbody>
</tbody>


Excel tables to the web >> Excel Jeanie HTML 4



Here is a mock up of my work book. There would be another sheet named Mick after I run my macro. I have just noticed the code you wrote does not work properly if it is not the top line that is changed to "YES"

BOB

*ABCDEFGHIJKLMNOPQR
3DELBATCHTYPELINEQTY**********BATCH RUNQTY*
410-Aug**BOB60**********YES*0
510-Aug**BOB60**********YES*0
610-Aug**BOB60**********NO60*
7****180***********60*
811-Aug**BOB45**********NO45*
911-Aug**BOB35**********YES*165
1011-Aug**BOB60**********NO60*
11****140***********270*
1212-Aug**BOB52**********NO52*
1312-Aug**BOB25**********NO25*
1412-Aug**BOB15**********NO15*
15****92***********92*

<tbody>
</tbody>

Spreadsheet Formulas
CellFormula
Q4=IF(P4="NO",E4,"")
Q5=IF(P5="NO",E5,"")
Q6=IF(P6="NO",E6,"")
E7=SUM(E4:E6)
Q7=SUM(Q4:R6)
Q8=IF(P8="NO",E8,"")
Q9=IF(P9="NO",E9,"")
Q10=IF(P10="NO",E10,"")
E11=SUM(E8:E10)
Q11=SUM(Q8:R10)
Q12=IF(P12="NO",E12,"")
Q13=IF(P13="NO",E13,"")
Q14=IF(P14="NO",E14,"")
E15=SUM(E12:E14)
Q15=SUM(Q12:R14)

<tbody>
</tbody>

<tbody>
</tbody>

Your code has put the 165 in "R9". Sorry for the long post but I though it would be more helpful if you knew the full story.

Many thanks,
Lobsterboy1
 
Upvote 0

Forum statistics

Threads
1,213,550
Messages
6,114,265
Members
448,558
Latest member
aivin

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