Search code examples
vbaexcelscientific-computing

Calculating desired value based on data table


I have a data table of volumes and total concentration. I want to input a value into a cell, and loop through the data table and output the total volume needed from the data table to calculate my new mixture.

Example data table:

sample #    Volume  concentration
1            4000.0    250000
2            4000.0    300000
3            4000.0    650000
4            4000.0    2000000

If this is my data, and I want to make a new batch that is 8000 volume and 700,000 for concentration, how can I calculate which sample numbers to mix and in what volumes to get the new concentration and volume.


Solution

  • I assume formula should be as follows:

    dilution formula

    Consider the algorithm implemented with the below VBA code, place the code in the Sheet1 module:

    Option Explicit
    
    Private Type Solution
        Volume As Variant
        Initial As Variant
        Conc As Variant
    End Type
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    
        Dim Samples() As Solution
        Dim ConcTarget As Double
        Dim ConcMin As Double
        Dim ConcMax As Double
        Dim ConcDelta As Double
        Dim ConcDelta1 As Double
        Dim ConcDelta2 As Double
        Dim VolumeTarget As Double
        Dim VolumeTotal As Double
        Dim VolumeMix As Double
        Dim Volume1 As Double
        Dim Volume2 As Double
        Dim Sample1 As Long
        Dim Sample2 As Long
        Dim Sample1Found As Boolean
        Dim Sample2Found As Boolean
        Dim i As Long
    
        Application.EnableEvents = False
    
        ' retrieve initial data and targets from the sheet and clear results
        i = 2
        With Sheets("Sheet1")
            Do While .Cells(i, 1) <> ""
                ReDim Preserve Samples(i - 2)
                Samples(i - 2).Volume = .Cells(i, 2).Value
                Samples(i - 2).Initial = Samples(i - 2).Volume
                Samples(i - 2).Conc = .Cells(i, 3).Value
                .Cells(i, 4).Value = ""
                i = i + 1
            Loop
            ConcTarget = .Cells(2, 7).Value
            VolumeTarget = .Cells(2, 6).Value
        End With
    
        VolumeTotal = 0
        ' begin of iterations
        Do
    
            ' min and max concentration available
            ConcMax = 0
            ConcMin = 1.7976931348623E+308
            For i = 0 To UBound(Samples)
                If Samples(i).Conc < ConcMin And Samples(i).Volume > 0 Then
                    ConcMin = Samples(i).Conc
                    Sample1 = i ' lowest concentration sample
                End If
                If Samples(i).Conc > ConcMax And Samples(i).Volume > 0 Then
                    ConcMax = Samples(i).Conc
                    Sample2 = i ' highest concentration sample
                End If
            Next
    
            If ConcMin > 0 Then
                ' zero concentration sample isn't available
                ' choose appropriate samples available to mix
                Sample1Found = False
                Sample2Found = False
                For i = UBound(Samples) To 0 Step -1
                    If Samples(i).Volume > 0 Then
                        Select Case True
                            Case Samples(i).Conc <= ConcTarget And Samples(i).Conc >= Samples(Sample1).Conc
                                ' closest less concentrate sample
                                Sample1 = i
                                Sample1Found = True
                            Case Samples(i).Conc >= ConcTarget And Samples(i).Conc <= Samples(Sample2).Conc
                                ' closest more concentrate sample
                                Sample2 = i
                                Sample2Found = True
                        End Select
                    End If
                Next
    
                ' check if necessary samples are available
                If Not (Sample1Found And Sample2Found) Then
                    Exit Do
                End If
            End If
    
            ' calculate delta for chosen samples
            ConcDelta = Samples(Sample2).Conc - Samples(Sample1).Conc
            ConcDelta1 = ConcTarget - Samples(Sample1).Conc
            ConcDelta2 = Samples(Sample2).Conc - ConcTarget
    
            ' calculate volumes
            Volume1 = (VolumeTarget - VolumeTotal) * ConcDelta2 / ConcDelta
            Volume2 = (VolumeTarget - VolumeTotal) * ConcDelta1 / ConcDelta
            VolumeMix = Volume1 + Volume2
    
            ' check if volumes are enough and reduce to available volume
            Select Case True
                Case Volume1 > Samples(Sample1).Volume ' sample 1 not enough
                    Volume1 = Samples(Sample1).Volume
                    VolumeMix = Volume1 * ConcDelta / ConcDelta2
                    Volume2 = VolumeMix * ConcDelta1 / ConcDelta
                    If Volume2 > Samples(Sample2).Volume Then ' sample 2 not enough
                        Volume2 = Samples(Sample2).Volume
                        VolumeMix = Volume2 * ConcDelta / ConcDelta1
                        Volume1 = VolumeMix * ConcDelta2 / ConcDelta
                    End If
                Case Volume2 > Samples(Sample2).Volume ' sample 2 not enough
                    Volume2 = Samples(Sample2).Volume
                    VolumeMix = Volume2 * ConcDelta / ConcDelta1
                    Volume1 = VolumeMix * ConcDelta2 / ConcDelta
                    If Volume1 > Samples(Sample1).Volume Then ' sample 1 not enough
                        Volume1 = Samples(Sample1).Volume
                        VolumeMix = Volume1 * ConcDelta / ConcDelta2
                        Volume2 = VolumeMix * ConcDelta1 / ConcDelta
                    End If
            End Select
    
            ' change available volumes
            Samples(Sample1).Volume = Samples(Sample1).Volume - Volume1
            Samples(Sample2).Volume = Samples(Sample2).Volume - Volume2
    
            ' check if target volume has been mixed
            VolumeTotal = VolumeTotal + VolumeMix
            If VolumeTotal = VolumeTarget Then Exit Do
    
        Loop
    
        ' results output
        With Sheets("Sheet1")
            For i = 0 To UBound(Samples)
                .Cells(i + 2, 4).Value = Samples(i).Initial - Samples(i).Volume
            Next
            .Cells(2, 5).Value = VolumeTotal
        End With
    
        Application.EnableEvents = True
    
    End Sub
    

    I populated Sheet1 with source data:

    initial data

    After that Worksheet_Change event is fired, and results are populated in "To be mixed" column and "Actual volume" cell. Any changes on the sheet give results immediately:

    results

    If any zero concentration sample is available then it will be used first of all:

    zero concentration sample