VBA verandert waarde cel niet

[mvanmeurs]

Beste forumgebruikers,

Ik zit met een fout in mijn code waar ik niet uit kom. Ik heb een document waar ik projecten aan kan maken door middel van een invoerformulier. Vervolgens maakt hij een tabblad aan met o.a. het projectnummer en hij voert wat gegevens in het 1e tabblad in wat het totaaloverzicht is. Dit gaat allemaal goed.

Nu heb ik een wijzigingsformulier gemaakt waarmee ik een project kan wijzigen. Hij wijzigt alles behalve het projectnummer (txtWijzigen_Projectnummer) in de 1e kolom van het werkblad "Totaaloverzicht". Het wijzigen van de naam van het tabblad en de bijbehorende hyperlinks gaan wel allemaal goed. Ook de TextToDisplay van de hyperlink in de 1e kolom verwijst naar het gewijzigde projectnummer alleen de celwaarde blijft staan op het oude. Waarschijnlijk heeft dit te maken met het kiezen van de oude waarde in de combolist om het juiste rijnummer te zoeken waar de gegevens in verandert worden maar ik weet niet hoe ik dit anders kan maken zodat het wel werkt.

Hieronder een stuk van de code waar het om draait (in het donkerblauw de regel die niet doet wat ik zou willen):

Private Sub UserForm_Initialize()
    
    Me.tb_WijzigingJaar1.Caption = Year(Date)
    Me.tb_WijzigingJaar2.Caption = Year(Date) + 1
    Me.tb_WijzigingJaar3.Caption = Year(Date) + 2
    Me.tb_WijzigingJaar4.Caption = Year(Date) + 3
    Me.tb_WijzigingJaar5.Caption = Year(Date) + 4
    Me.tb_WijzigingJaar6.Caption = Year(Date) + 5
    Me.tb_WijzigingJaar7.Caption = Year(Date) + 6
    
'Laat de inhoud uit de kolommen zien


sn = ActiveSheet.Range("A10:B10" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row).Value
    For I = 1 To UBound(sn)
        With cmbWijzigen_Projecten
            .ColumnCount = 2
            .ColumnWidths = "60,120"
            .AddItem sn(I, 1)
            .List(UBound(cmbWijzigen_Projecten.List), 1) = sn(I, 2)
       End With
    Next


End Sub


Private Sub cmbWijzigen_Projecten_AfterUpdate()


Dim VindRij
Set VindRij = Worksheets("Totaaloverzicht").Range("A:A").Find(What:=Me.cmbWijzigen_Projecten.Value, LookIn:=xlValues, lookAt:=xlWhole)
txtWijzigen_Projectnummer.Value = Worksheets("Totaaloverzicht").Cells(VindRij.Row, 1).Value
txtWijzigen_Projectnaam.Value = Worksheets("Totaaloverzicht").Cells(VindRij.Row, 2).Value
txtWijzigen_Projectleider.Value = Worksheets("Totaaloverzicht").Cells(VindRij.Row, 3).Value
End Sub


Private Sub cmdProject_WijzigingenDoorvoeren_Click()

'Selecteer de juiste rij
Dim VindRij
Set VindRij = Worksheets("Totaaloverzicht").Range("A:A").Find(What:=Me.cmbWijzigen_Projecten.Value, LookIn:=xlValues, lookAt:=xlWhole)

'Geef de invulvelden een makkelijke naam
Dim BestaandProjectnummer, WijzigingsProjectnummer, WijzigingsProjectnaam, WijzigingsProjectleider As String

BestaandProjectnummer = cmbWijzigen_Projecten.Value
WijzigingsProjectnummer = Me.txtWijzigen_Projectnummer.Value
WijzigingsProjectnaam = Me.txtWijzigen_Projectnaam.Value
WijzigingsProjectleider = Me.txtWijzigen_Projectleider.Value

'Controleer of er een projectnummer is ingevuld

If WijzigingsProjectnummer = vbNullString Then
    MsgBox "Voer een projectnummer in"

'Controleer of er geen dubbel projectnummer is ingevuld
Else
   wsBestaat = False
      For Each ws In Worksheets
        If ws.Name = WijzigingsProjectnummer Then
           wsBestaat = True
           MsgBox "Ingevoerd projectnummer bestaat al, voer een ander projectnummer in"
           Me.txtWijzigen_Projectnummer.SetFocus
        End If
      Next
        If Not wsBestaat Then
        GoTo Wijzigalles
        End If
        
Wijzigalles:

'Verberg scherm update
Application.ScreenUpdating = False

'Geef het tabblad een gewijzigde naam
Sheets(BestaandProjectnummer).Name = WijzigingsProjectnummer
              
'Wijzig projectnummer in totaaloverzicht
[COLOR=#000080]
Worksheets("Totaaloverzicht").Hyperlinks.Add Anchor:=Worksheets("Totaaloverzicht").Cells(VindRij.Row, 1), Address:="", SubAddress:= _
        "'" & WijzigingsProjectnummer & "'!R1K1", TextToDisplay:=WijzigingsProjectnummer, ScreenTip:="Hiermee gaat u naar " & WijzigingsProjectnummer[/COLOR]
                'Font van de hyperlink aanpassen
                Worksheets("Totaaloverzicht").Cells(VindRij.Row, 1).Font.Bold = True
                Worksheets("Totaaloverzicht").Cells(VindRij.Row, 1).Font.Name = "MS Sans Serif"
                Worksheets("Totaaloverzicht").Cells(VindRij.Row, 1).Font.Size = 12
                Worksheets("Totaaloverzicht").Cells(VindRij.Row, 1).Font.Underline = xlUnderlineStyleNone
                Worksheets("Totaaloverzicht").Cells(VindRij.Row, 1).Font.Color = 5

'Wijzig projectnaam in totaaloverzicht
Worksheets("Totaaloverzicht").Hyperlinks.Add Anchor:=Worksheets("Totaaloverzicht").Cells(VindRij.Row, 2), Address:="", SubAddress:= _
        "'" & WijzigingsProjectnummer & "'!R1K1", TextToDisplay:=WijzigingsProjectnaam, ScreenTip:="Hiermee gaat u naar " & WijzigingsProjectnummer
                'Font van de hyperlink aanpassen
                Worksheets("Totaaloverzicht").Cells(VindRij.Row, 2).Font.Bold = True
                Worksheets("Totaaloverzicht").Cells(VindRij.Row, 2).Font.Name = "MS Sans Serif"
                Worksheets("Totaaloverzicht").Cells(VindRij.Row, 2).Font.Size = 12
                Worksheets("Totaaloverzicht").Cells(VindRij.Row, 2).Font.Underline = xlUnderlineStyleNone
                Worksheets("Totaaloverzicht").Cells(VindRij.Row, 2).Font.Color = 5

'Wijzig projectleider in totaaloverzicht
Worksheets("Totaaloverzicht").Cells(VindRij.Row, 3).Value = WijzigingsProjectleider

'Wijzig de celverwijzingen
Worksheets("Totaaloverzicht").Cells(VindRij.Row, 4).FormulaR1C1 = "='" & WijzigingsProjectnummer & "'!R9C6"
Worksheets("Totaaloverzicht").Cells(VindRij.Row, 5).FormulaR1C1 = "='" & WijzigingsProjectnummer & "'!R9C7"
Worksheets("Totaaloverzicht").Cells(VindRij.Row, 6).FormulaR1C1 = "='" & WijzigingsProjectnummer & "'!R9C8"
Worksheets("Totaaloverzicht").Cells(VindRij.Row, 7).FormulaR1C1 = "='" & WijzigingsProjectnummer & "'!R9C9"
Worksheets("Totaaloverzicht").Cells(VindRij.Row, 8).FormulaR1C1 = "='" & WijzigingsProjectnummer & "'!R9C11"


'Gegevens in Werkblad zetten


Dim Aktiefblad As Worksheet

Set Aktiefblad = Worksheets(WijzigingsProjectnummer)

Aktiefblad.Cells(2, 3).Value = WijzigingsProjectnaam
Aktiefblad.Cells(3, 3).Value = WijzigingsProjectnummer
Aktiefblad.Cells(4, 3).Value = WijzigingsProjectleider

'Zet scherm update weer aan
Application.ScreenUpdating = True

End If
Unload Me
End Sub

Hieronder een link naar het complete bestand

http://www.fileupload.nl/6d6bfca47a5cd2c4

 

[OctaFish]

Een bestandje doet veel meer voor je antwoorden dan alleen code .

 

[Elsendoorn2134]

M van Meurs,

Een hyperlink kan alleen worden toegevoegd in een cel als in deze cel nog geen hyperlink staat, anders faalt de procedure Add.
Oplossing is door de hyperlink die er staat eerst te verwijderen.

Veel Succes.