Need to count blank cells between two non-blank cells

mynameisnotbob

New Member
Joined
Jun 22, 2019
Messages
4
I have a sheet for the days of the week, and hours within the day. Every hour worked has a '1' in the corresponding cell. Every hour not worked is blank. I need to calculate the number of hours between worked hours.

MondayTuesdayWednesdayThursdayFridaySaturdaySundayMonday
0:001
1:001
2:001
3:001
4:001
5:001
6:00 1 1 1
7:0011 1
8:0011 1
9:0011 1
10:0011 1
11:0011 1
12:0011 1
13:0011 1
14:0011 1
15:0011 1
16:0011 1
17:00 1 1 1
18:001
19:001
20:001
21:001
22:001
23:00 1
30362448

<colgroup><col span="5"><col><col span="3"></colgroup><tbody>
</tbody>

What formula can I use to count the number of blank cells from the last "1" to the next "1" in consecutive hours.
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Here's a macro :
Code:
Sub v()
Dim r%, c%, rng As Range, area As Range
Application.ScreenUpdating = False
With [B26:I26]
    .Formula = "=IF(OR(AND(A25<>"""",B2<>""""),COUNTA(B2:B25)=0),"""",""E"")"
    .Value = .Value
End With
r = 26
For c = 2 To 9
    Cells(2, c).Resize(24).Copy Cells(r, 1)
    r = r + 24
Next
Set rng = Range("A2:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeBlanks)
For Each area In rng.Areas
    [B26:I26].Find("E").Value = area.Count
Next
[A26].Resize(8 * 24).ClearContents
End Sub
 
Upvote 0
To run automatically :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r%, c%, rng As Range, area As Range
If Not Intersect(Target, [B2:I25]) Is Nothing Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    With [B26:I26]
        .Formula = "=IF(OR(AND(A25<>"""",B2<>""""),COUNTA(B2:B25)=0),"""",""E"")"
        .Value = .Value
    End With
    r = 26
    For c = 2 To 9
        Cells(2, c).Resize(24).Copy Cells(r, 1)
        r = r + 24
    Next
    Set rng = Range("A2:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeBlanks)
    For Each area In rng.Areas
        [B26:I26].Find("E").Value = area.Count
    Next
    [A26].Resize(8 * 24).ClearContents
    Application.EnableEvents = True
End If
End Sub
 
Last edited:
Upvote 0
If using the macro, if I needed this to go out for a full year of days, would I just change :I26 to :ZZ26? (or whatever the columns go out to...)
 
Upvote 0
Is there a non-macro solution? My company frowns upon using macros saved on the server...
Here is an array-entered** formula that appears to work. I would be surprised if someone does not find a more efficient formula, but this was all I could come up with. Place the following formula in cell B26 and copy it across...

=IF(COUNTBLANK(B2:B25)=24,"",SUM(IFERROR(MATCH(1,--(LEN(B2:B25)>0),0)-1,24))+COUNTBLANK($A2:A25)-SUM($A26:A26))

**Commit this formula using CTRL+SHIFT+ENTER and not just Enter by itself

Note: If you want to place the formula on a different row, then change the red numbers to that new row number.
 
Last edited:
Upvote 0
Thanks to both of you!! Appreciate everything.

The formula works.

For curiosty sake, I'd still like to know the macro... but its no longer needed.
 
Upvote 0
For curiosty sake, I'd still like to know the macro... but its no longer needed.
Code:
Sub v()
Dim lc%, r%, c%, rng As Range, area As Range
lc = Cells(1, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
With [B26].Resize(, lc - 1)
    .Formula = "=IF(OR(AND(A25<>"""",B2<>""""),COUNTA(B2:B25)=0),"""",""E"")"
    .Value = .Value
End With
r = 26
For c = 2 To lc
    Cells(2, c).Resize(24).Copy Cells(r, 1)
    r = r + 24
Next
Set rng = Range("A2:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeBlanks)
For Each area In rng.Areas
    [B26].Resize(, lc - 1).Find("E").Value = area.Count
Next
[A26].Resize((lc - 1) * 24).ClearContents
End Sub
Could simplify the macro by making use of the formula solution.
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,184
Members
448,554
Latest member
Gleisner2

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