Celkleur mbv aselect en vba

[wiki]

Ik probeer een loop van Rob de Bruin aan te passen om op basis van een aselect formule een celkleur te bepalen. Ik gebruik deze om bij het invoegen van een rij automatisch de kleur van een cel aan te passen. Ik krijg de code niet aangepast. Het volgende stuk heb ik vervangen

With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    If .Value = "ron" Then .EntireRow.Delete

door

With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    If .FormulaR1C1 = "=ASELECTTUSSEN(1,56)" Then With Selection
                    .Interior.ColorIndex = Selection.Value
                    .Font.ColorIndex = Selection.Value
   End With

Ik krijg de foutmelding End if zonder blok if

Wat doe ik fout

 

[Finch]

Ge moet u if-then structuren afsluiten met een end if. Jij hebt twee if-en dus moet je ook tweemaal end if hebben.

PS. Formules in VBA taal moeten ook in het Engels gebeuren ook al heb je een NL Excel. Dus ipv aselecttussen dien je randbetween te gebruiken.

 

[wiki]

Beste Finch,

Dit had ik al geprobeerd, voor en na de end with, maar de foutmelding blijft
De aselect heb ik opgenomen en werkt prima in NL bij herhaling

 

[JanCoonen]

Dag Wiki,

Finch heeft gelijk. De "end if" die in het bold staat, staat niet in jouw code. Aanpassen en je krijgt de foutmelding in ieder geval niet meer.

With .Cells(Lrow, "A")

                If Not IsError(.Value) Then

                    If .FormulaR1C1 = "=ASELECTTUSSEN(1,56)" Then
                        With Selection
                            .Interior.ColorIndex = Selection.Value
                            .Font.ColorIndex = Selection.Value
                        End With
                    [B]End If[/B]
                    'in Column A, case sensitive.
 
                End If

            End With

Groeten en succes ermee.

Jan.

 

[wiki]

Hebben jullie dat getest of geconcludeeerd uit de tekst?

Sub Loop_Example()
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

        With ActiveSheet
       .Select

        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView

       .DisplayPageBreaks = False

        Firstrow = 11
        Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        For Lrow = Lastrow To Firstrow Step -1

          With .Cells(Lrow, "A")

          If Not IsError(.Value) Then

                    If .FormulaR1C1 = "=ASELECTTUSSEN(1,56)" Then With Selection
                    .Interior.ColorIndex = Selection.Value
                    .Font.ColorIndex = Selection.Value
                    End If         
End With
                 End If
            End With
        Next Lrow
    End With
    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With

End Sub

Dit is de volledige routine met een extra end if, maar bij testen krijg ik nog steeds de melding if zonder end if.

 

[JanCoonen]

Je moet je code well-formed houden ... innerlussen moeten gesloten worden .. de code hieronder compileert foutloos

        For Lrow = Lastrow To Firstrow Step -1
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    If .FormulaR1C1 = "=ASELECTTUSSEN(1,56)" Then
                        With Selection
                            .Interior.ColorIndex = Selection.Value
                            .Font.ColorIndex = Selection.Value
                            ' om te starten zou hier al een end with moeten staan -
                            ' End If
                            
                        End With
                    End If
                End If
            End With
        Next Lrow

 

[wiki]

Het loopt nog niet. Ik ben de foutmelding kwijt, maar alleen de kleur van de actieve cel wordt aangepast. De loop start niet bij de laatste rij, stopt niet bij rij 11 en kijkt niet in rij A

 

[wiki]

Het belangrijkste heb ik opgelost

Sub kleur()

' This loop repeats for a fixed number of times determined by the number of rows

' in the range

    Dim i As Integer
        Range("P11").Select
 If ActiveCell.FormulaR1C1 = "=ASELECTTUSSEN(1,56)" Then
    For i = 1 To Selection.CurrentRegion.Rows.Count - 1

  
With Selection.Interior
        .ColorIndex = Selection.Value
        .Pattern = xlSolid
    End With
    Selection.Font.ColorIndex = Selection.Value
    ActiveCell.Offset(1, 0).Select

    Next i
End If
End Sub

Moet alleen kolom en rij 11 nog benoemen.