Foutmelding in de VBA

[rvt1982]

Beste Leden,

Ik krijg een fout melding zodra er een verkeerde datum in de lijst staat..
de datum van vandaag t/m over 7 dagen moeten zichtbaar zijn, de andere datums moeten gewoon genegeerd worden.

bij de fout controle word de "rode tekst" bij mij aangewezen dat dit fout zit.

Wie o wie kan mij helpen

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range, c As Variant, rij As Integer, q As Variant, nummer As Integer
 Application.ScreenUpdating = False
  Sheets("Agenda").Rows("2:2").Hidden = False
   With Sheets("Agenda").Range("B4:FS100")
    .ClearContents
    .Interior.ColorIndex = xlNone
    .UnMerge
   End With
With Sheets("AgendaData")
  For Each cl In .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    If cl > 0 Then
 With Sheets("Agenda")
   .Columns("B:FM").ColumnWidth = 45
      Set c = .Range("B2:FM2").Find(cl.Offset(, 1), LookIn:=xlValues)
   .Columns("B:FM").ColumnWidth = 3
     rij = WorksheetFunction.Match(cl.Offset(, 2), .Range("A1:A500"), 0)
[COLOR="red"]     rij = rij + .Cells(rij, c.Column - 1).CurrentRegion.Rows.Count[/COLOR]
 
If Not c Is Nothing Then
  nummer = 0
   Do Until nummer = 24
       If .Range(c.Address).Offset(1, nummer).Value = cl.Offset(, 3) Then
   q = IIf(cl.Offset(, 4) < cl.Offset(, 3), cl.Offset(, 4) + 25 - cl.Offset(, 3), _
     cl.Offset(, 4) - cl.Offset(, 3))
  If .Cells(rij, c.Column - 1) = 1 Then
    .Cells(rij - 1, c.Column - 1).Offset(1) = 1
  Else
    .Cells(rij, c.Column - 1) = 1
  End If
      .Range(c.Address).Offset(rij - 3, nummer) = cl
        .Range(c.Address).Offset(rij - 3, nummer).HorizontalAlignment = xlVAlignCenter
         .Range(c.Address).Offset(rij - 3, nummer).Resize(, q).Merge
           .Range(c.Address).Offset(rij - 3, nummer).Resize(, q).Interior.ColorIndex = 3: Exit Do
         End If
        nummer = nummer + 1
      Loop
      
     End If
     End With
    End If
  Next
End With
  With Sheets("Agenda")
    .Rows("2:2").Hidden = True
    .Rows("4:4").Hidden = True
    .Columns("B:B").Hidden = True
    .Columns("AA:AA").Hidden = True
    .Columns("AZ:AZ").Hidden = True
    .Columns("BY:BY").Hidden = True
    .Columns("CX:CX").Hidden = True
    .Columns("DW:DW").Hidden = True
    .Columns("EV:EV").Hidden = True
  End With
 Application.ScreenUpdating = False
End Sub

 

[Roncancio]

Zo te zien kan c niet gevonden worden.
Je kunt beter eerst bepalen of c gevonden wordt en vervolgens de waarde van c gebruiken in de formule.

Met vriendelijke groet,


Roncancio

 

[rvt1982]

Beste Roncancio,

mmm... dit gaat boven mijn pet..
het is zo dat in kolom B een datum zit die van gisteren is. zodra ik deze naar vandaag aanpas werk deze weer helemaal goed.
zou je voor mij willen kijken wat ik moet aanpassen zodat de code alleen de datums van vandaag t/m 7 dagen laat zien en de rest negeert ..

Alvast bedankt.

 

[Roncancio]

Wat ik in mijn vorige reactie bedoelde is het volgende.
In je code staat onder meer:

     rij = WorksheetFunction.Match(cl.Offset(, 2), .Range("A1:A500"), 0)
     rij = rij + .Cells(rij, c.Column - 1).CurrentRegion.Rows.Count
 
If Not c Is Nothing Then

Eerst laat je de code bepalen wat rij wordt (2 * rij =) en vervolgens gaat de code bekijken of c wel gevonden kan worden.
Dat lijkt mij niet logisch.
Logischer is om eerst te bekijken of c gevonden wordt en vervolgens wordt rij bepaald.
Dus zoiets:

If Not c Is Nothing Then
     rij = WorksheetFunction.Match(cl.Offset(, 2), .Range("A1:A500"), 0)
     rij = rij + .Cells(rij, c.Column - 1).CurrentRegion.Rows.Count

Met vriendelijke groet,


Roncancio