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.
 

Some videos you may like

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,006
Office Version
2016
Platform
Windows
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
 

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,006
Office Version
2016
Platform
Windows
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:

mynameisnotbob

New Member
Joined
Jun 22, 2019
Messages
4
Thanks so much!

Is there a non-macro solution? My company frowns upon using macros saved on the server...
 

mynameisnotbob

New Member
Joined
Jun 22, 2019
Messages
4
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...)
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
35,900
Office Version
2010
Platform
Windows
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:

mynameisnotbob

New Member
Joined
Jun 22, 2019
Messages
4
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.
 

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,006
Office Version
2016
Platform
Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,098,855
Messages
5,465,095
Members
406,412
Latest member
superjoejoe

This Week's Hot Topics

Top