Rijen doorzoeken en alle laagste waarden bepalen per rij (prijsvergelijk)

[Lampje84]

Beste vba expers.
In de korte tijd dat ik me met vba bezig houd heb ik al veel hulp gehad van dit forum.
Nu zit ik echter met een probleem waar ik (via dit forum en google) niet uit kom.

In het bijgevoegde bestand wordt het probleem duidelijk.
Het bestand waar ik de code straks voor wil gaan vergelijken heeft dezelfde opbouw.

Ik heb via dit forum al een code gevonden, echter wil het me niet lukken om deze aan te passen naar mijn wensen: eigenlijk een uitgebreid prijsvergelijkingsbestand maken. Diverse prijzen (range) met elkaar vergelijken en per rij de laagste waarde kleuren, bij meerdere laagste waardes alle cellen kleuren.

Alles wat ik vindt selecteerd wel de laagste waarde maar gaat de fout in als er lege cellen of cellen met formule

Misschien is het wel een eitje voor jullie, maar mijn vba kennis gaat niet zo heel ver helaas.

Groeten!

 

[wampier]

Ik weet niet of er een makkelijkere manier via ingebouwde functies is, maar er zijn twee manieren waarop het in ieder geval werkt:

1) Extra kolommen toevoegen en de data eerst bewerken, waarmee je het probleem afvangt dan daarna de huidige functie opnieuw proberen. Is niet extreem flexibel als je heel veel kolommen wil gebruiken

2) Je kunt ook handmatig 2x over elke rij lopen en zelf de laagste waarde bepalen. Eerste pass bepaal je de lengte en laagste waarde. tweede pass kleur je alle cellen gelijk aan de laagst gevonden waarde.

 

[Mark xl]

Stel Voorwaardelijke opmaak in voor kolommen R t/m V (of pas het eventueel naar behoefte aan)
=ALS(EN(ISGETAL(R1);R1=MIN($R1:$V1));WAAR;ONWAAR)


In VBA kan het bijvoorbeeld op deze manier. pas gerust wat aan naar behoefte.

Sub laagste()
Const startrow As Long = 7      'aanpassen aan behoefte

Dim icol As Integer
Dim Endrow As Long
Dim cheap As Double
Dim MyVar As Variant

With Sheets("Blad1")
    
    icol = .Range("Q7", .Range("IV6").End(xlToLeft)).Columns.Count
    Endrow = .Cells.SpecialCells(xlCellTypeLastCell).Row

End With


For i = startrow To Endrow

    MyVar = Range("Q" & i).Resize(, icol)
    cheap = WorksheetFunction.Min(Range("Q" & i).Resize(, icol))
    
    If cheap <> 0 Then
    
        For j = 1 To UBound(MyVar, 2)
            
            'checkt ook cellen die niet laagste zijn en geeft deze geen kleur (constante xlnone)
            Range("P" & i).Offset(, j).Interior.ColorIndex = IIf(MyVar(1, j) = cheap, 6, xlNone)
         
         Next j
        
    End If
     
Next i
End Sub

Je kunt natuurlijk ook de voorwaardelijke opmaak instellen via vba, maar het lukte me niet 1-2-3 om die formule te laten accepteren.
das meteen een leuke vervolgvraag van mij:

Wat voor type formule accepteert de Eigenschap formatconditions? Via het venster direct mag ik onderstaande formule in een cel plaatsen, maar niet via Formatconditions.Add
Moet ik voor nederlandse excel een nederlandse formule noteren bij deze Eigenschap?
bijv "=ALS(EN(R7<>"""";R7=MIN($R7:$V7));WAAR;ONWAAR)"

En ter verduidelijking : devariabele icol is > 0

myValidationRange.FormatConditions.Add _
        Type:=xlExpression, Formula1:="=IF(AND(RC18<>"""",RC18=MIN(RC18:RC[" & icol & "])),true,false)"

 

[Lampje84]

Bedankt voor de Reacties.

Ik had het tijdelijk met voorwaardelijke opmaak kunnen doen, echter moet ik dan een vast bereik opgeven.
Zal eens proberen om het met de code voor elkaar te krijgen!

Groeten