Data in eerstvolgende lege cell plaatsen

[tijmen_4real]

Hoi,

Zie deze afbeelding:



De laagste waarde (min) uit een gedeelte (AA23 t/m AA34) wil ik door middel van deze code:

Sub MinimaleHardheidPerDag()
Dim R As Range, lastrow As Long
lastrow = Sheets("data").Cells(Cells.Rows.Count, "F").End(xlUp).Row + 1
    Dim a As Range
    Set a = Range("AA23:AA34")
    Sheets("data").Range("F" & lastrow).Value = Application.WorksheetFunction.Min(a)
End Sub

Naar de sheet genaamd "data" in de eerstvolgende lege rij laten invullen.



Maar zoals je ziet vult hij het niet in de eerste lege rij in, maar onder de gehele kolom. (1,1,1)
Wat gaat er mis? En nog belangrijker, hoe los ik dit op?

Bij voorbaat dank en met vriendelijke groet,

Tijmen

 

[edmoor]

Daar gaat niks mis, Excel vult het keurig in de eerste lege rij in.
Dat je zelf iets anders bedoelt met "lege rij" is een ander verhaal.
Plaats je document in plaats van alleen die plaatjes.

 

[tijmen_4real]

Plaats je document in plaats van alleen die plaatjes.

Document, geknipt tot de hierbij benodigde tabbladen:
Bekijk bijlage procentenlijst_tabletten - test_hmorum.xlsm

 

[SjonR]

probeer het eens zo:

Sub MinimaleHardheidPerDag()
Dim R As Range, lastrow As Long
lastrow = Sheets("Data").Range("F:F").SpecialCells(4).Row
    Dim a As Range
    Set a = Range("AA23:AA34")
    Sheets("data").Range("F" & lastrow).Value = Application.WorksheetFunction.Min(a)
End Sub

 

[tijmen_4real]

Werkt prima! Dank hiervoor.

 

[tijmen_4real]

probeer het eens zo:

Sub MinimaleHardheidPerDag()
Dim R As Range, lastrow As Long
lastrow = Sheets("Data").Range("F:F").SpecialCells(4).Row
    Dim a As Range
    Set a = Range("AA23:AA34")
    Sheets("data").Range("F" & lastrow).Value = Application.WorksheetFunction.Min(a)
End Sub

Nog een vraag: wanneer ik dit voor meerdere data wil toevoegen:

Sub MinimaleHardheidPerDag()
Dim R As Range, lastrow As Long
lastrow = Sheets("Data").Range("F:F").SpecialCells(4).Row
    Dim a As Range
    Set a = Range("AA23:AA34")
    Sheets("data").Range("F" & lastrow).Value = Application.WorksheetFunction.Min(a)
End Sub

Sub MaximaleeHardheidPerDag()
Dim R As Range, lastrow1 As Long
lastrow1 = Sheets("Data").Range("G:G").SpecialCells(4).Row
    Dim b As Range
    Set b = Range("AA23:AA34")
    Sheets("data").Range("G" & lastrow1).Value = Application.WorksheetFunction.Max(b)
End Sub

Dan werken ze geen van beide. Ik heb zoveel mogelijk aangepast. Enkel van min -> max en in een andere cel f -> g plaatsen.
Waarom werken ze niet allebei tegelijkertijd?

 

[edmoor]

Het zijn 2 losse routines dus zal je ze ook allebei per stuk moeten uitvoeren.

 

[tijmen_4real]

Het zijn 2 losse routines dus zal je ze ook allebei per stuk moeten uitvoeren.

Sorry, maar daar begrijp ik je niet helemaal. Het zijn beiden subs, maar hoe bedoel je "per stuk uitvoeren"?

 

[edmoor]

Ergens zal je zo'n sub uitvoeren neem ik aan.
Door een druk op een knop of iets anders.

 

[SjonR]

de eerste werkt prima ( de min dus) maar de max werkt niet. Dit komt doordat je cel F1 en G1 hebt samengevoegd. VBA en samengevoegde cellen kunnen heeeeeeeel soms trouwen, maar een scheiding is onvermijdelijk.

als je de samenvoeging opheft en in cel G1 iets zet, zal het werken.

 

[tijmen_4real]

de eerste werkt prima ( de min dus) maar de max werkt niet. Dit komt doordat je cel F1 en G1 hebt samengevoegd. VBA en samengevoegde cellen kunnen heeeeeeeel soms trouwen, maar een scheiding is onvermijdelijk.

als je de samenvoeging opheft en in cel G1 iets zet, zal het werken.

Ik moest even nadenken, maar begrijp je nu wel.
Daarna de code aangepast, met nog een extra toevoeging (datum trigger)

Sub MinimaleHardheidPerDag()
Dim R As Range, lastrow As Long
lastrow = Sheets("Data").Range("F:F").SpecialCells(4).Row
    Dim a As Range
    Set a = Range("AB23:AB34")
    Sheets("data").Range("F" & lastrow).Value = Application.WorksheetFunction.Min(a)
End Sub

Sub MinimaleDiktePerDag()
Dim R As Range, lastrow As Long
lastrow = Sheets("Data").Range("H:H").SpecialCells(4).Row
    Dim a As Range
    Set a = Range("AB23:AB34")
    Sheets("data").Range("H" & lastrow).Value = Application.WorksheetFunction.Min(a)
End Sub

Sub MaximaleHardheidPerDag()
Dim R As Range, lastrow As Long
lastrow = Sheets("Data").Range("G:G").SpecialCells(4).Row
    Dim a As Range
    Set a = Range("AA23:AA34")
    Sheets("data").Range("G" & lastrow).Value = Application.WorksheetFunction.Max(a)
End Sub

Sub MaximaleDiktePerDag()
Dim R As Range, lastrow As Long
lastrow = Sheets("Data").Range("I:I").SpecialCells(4).Row
    Dim a As Range
    Set a = Range("AB23:AB34")
    Sheets("data").Range("I" & lastrow).Value = Application.WorksheetFunction.Max(a)
End Sub

Sub Workbook_Open()
If Date = Range("Y8").Value + 1 Then
Call MinimaleHardheidPerDag
Call MinimaleDiktePerDag
Call MaximaleHardheidPerDag
Call MaximaleDiktePerDag
End If
End Sub

Toch even delen, wellicht dat er iemand baat bij heeft.
Veel dank voor de hulp!