Antal blanke i et område

Sub Count_Blank()
  Dim rg1 As Range
  Set rg1 = ActiveCell.CurrentRegion
  MsgBox Application.Evaluate("COUNTBLANK(" & rg1.Address & ")")
End Sub

Jeg har et regneark med medarbejdere ud af vandret og uger ned lodret. Jeg vil gerne kunne stille mig i en vilkårlig celle i en vilkårlig uge, hvor jeg får antal blanke, så jeg kan se ledig tid i den pågældende uge, men vælg aktuelle område omfører sig mærkeligt, så kan man definere rangen udfra aktive celle, ligegyldigt hvilken celle jeg er i ??

Eks. vis: 

aktive celle H843 – tæl antal blanke i rangen E838:I847
aktive celle g840 – tæl antal blanke i rangen E838:I847
aktive celle f852 – tæl antal blanke i rangen E850:I859
osv…..

Håber du forstår !!!! :-)

Min VBA kode ser sådan ud:

Sub Count_Blank()
her = ActiveCell.Address
  Dim rg1 As Range
  Set rg1 = ActiveCell.CurrentRegion
  MsgBox "Der er " & Application.Evaluate("COUNTBLANK(" & rg1.Address & ")/2") & " ledige dage!"
ActiveCell.CurrentRegion.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
    With Selection.Interior
        .ColorIndex = 3
        .Pattern = xlSolid
    End With
Application.Wait (Now + TimeValue("0:00:04"))
Selection.Interior.ColorIndex = xlNone
End If
Range(her).Select
End Sub

Der er 2 problemer med ovenstående, som beskrevet udvælges det aktuelle område ikke altid rigtig (se ovenfor) og de tomme celler skal markeres med rødt i 4 sekunder, hvorefter de skal gå tilbage til den farve de havde før markeringen. I min kode 0-stilles alle farver, hvilket går ud over ferierne, som er markeret med gul og søndage med blåt. Kan man vælge rød farve i de tomme felter i 4 sekunder og derefter vælge fortryd via VBA ?? Hvordan ??

For ikke at ødelægge din farvelægning, bruger denne betinget formatering istedet.
Håber så ikke at du bruger det i forvejen.
Mht. dit spm 10:33:52 bliver jeg nok nødt til at se arket, for at finde din systematik.

Sub Count_Blank()
Dim rg1 As Range
  Set rg1 = ActiveCell.CurrentRegion
  MsgBox "Der er " & Application.Evaluate("COUNTBLANK(" & rg1.Address & ")/2") & " ledige dage!"
  rg1.FormatConditions.Delete
  rg1.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
                            Formula1:="="""""
  rg1.FormatConditions(1).Interior.ColorIndex = 3
  Application.Wait (Now + TimeValue("0:00:04"))
  rg1.FormatConditions.Delete
End Sub

Jeg bruger alle 3 betingede formateringer i forvejen.... ville gerne have flere kan man det ??

Jeg har faktisk i stedet brugt mønstre (pattern) istedet, da jeg bruger mange farver men ingen mønstre, så dem kan jeg godt slette igen.

Mht. aktuelle område, så markeres hele regnearkets tomme celler, hvilket ikke er meningen, da det kun skulle være inden for en uge, men jeg har sat en if-sætning ind, så hvis tomme celler er mindre end 2, så laver den ikke mønstre.

Men BAK tusind tak for hjælpen, det er ikke først gang, og jeg tror jeg taler for mange VBA programmører i Excel, du er en kæmpe hjælp med alle de svar du har givet herinde.... så tak for det og send lige et svar, så jeg kan give point....

VBA ser sådan ud:

Sub Count_Blank()
her = ActiveCell.Address
  Dim rg1 As Range
  Set rg1 = ActiveCell.CurrentRegion
If Application.Evaluate("COUNTBLANK(" & rg1.Address & ")/2") > 1 Then
ActiveCell.CurrentRegion.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
    With Selection.Interior
        .Pattern = xlSemiGray75
        .PatternColorIndex = 3
    End With
MsgBox "Der er " & Application.Evaluate("COUNTBLANK(" & rg1.Address & ")/2") & " ledige dage i valgte periode!"
Application.Wait (Now + TimeValue("0:00:01"))
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
Else
Application.ScreenUpdating = False
MsgBox "Kun én celle markeres. Prøv igen fra en anden celle (evt. ugenr.)!"
Application.ScreenUpdating = True
End If
Range(her).Select
End Sub

Tak for rosen :-)