VBA Macro count empty cells and interpolate between values

[ttsh4]

Hi

Please Help!

I am trying to write a VBA Excel macro that looks at a large set of data and is able to interpolate between values that only appear every 125 rows or so (this being the tricky bit!).

What I need to be able to do is count the number of empty cells between two cells with values in, and then fill in these cells by interpolating based on the start and end values.

The problem I have is that the values are not always 125 rows apart, sometimes they are 123,124,125,126,127. The column length is ~40,000 cells hence the need for a macro!!

So, I need a way of automating the finding the first start and end value cells, calculating the number of non-value cells between these, interpolating, and then moving down (through some loop) to next start and end point.

Any ideas or thoughts much appreciated!!!

 

[ttsh4]

illustration of problem!

 

[b.downey]

The attached code will process the data per your requirements for columns "G" and "H". If it works as you expect, it is easy to change to to apply the rule set out to Columns "V"

Option Explicit
Sub interp()
    Dim rng As Range
    Dim RowNo As Long
    Dim ColNo As Long
    
    Dim StartRow As Long
    Dim EndRow As Long
    Dim Recs As Long
    Dim Factor As Double
    
    Set rng = ThisWorkbook.Worksheets(1).UsedRange
    
    StartRow = FindNoEmpty(rng, 1)
    EndRow = FindNoEmpty(rng, StartRow + 1)
    Do While (StartRow <= rng.Rows.Count) And (EndRow <> 0)
        Recs = EndRow - StartRow
        
        For ColNo = 7 To 8        '7 is "G"...   need to go to col "V"
            Factor = (rng.Cells(EndRow, ColNo) - rng.Cells(StartRow, ColNo)) / Recs
    
            For RowNo = StartRow + 1 To EndRow - 1
                rng.Cells(RowNo, ColNo) = rng.Cells(StartRow, ColNo) + (RowNo - StartRow) * Factor
            Next RowNo
        Next ColNo
        
        StartRow = EndRow
        EndRow = FindNoEmpty(rng, StartRow + 1)
    Loop

 

[ttsh4]

Hi

Thanks for your reply, I tried to run the script but get the error shown below..

Any ideas?!

 

[b.downey]

It appears to be a cut and paste error on my part. Here is the entire code set.

Option Explicit
Sub interp()
    Dim rng As Range
    Dim RowNo As Long
    Dim ColNo As Long
    
    Dim StartRow As Long
    Dim EndRow As Long
    Dim Recs As Long
    Dim Factor As Double
    
    Set rng = ThisWorkbook.Worksheets(1).UsedRange
    
    StartRow = FindNoEmpty(rng, 1, "G")
    EndRow = FindNoEmpty(rng, StartRow + 1, "G")
    Debug.Print StartRow, EndRow
    
    Do While (StartRow <= rng.Rows.Count) And (EndRow <> 0)
        Recs = EndRow - StartRow
        
        For ColNo = 7 To 8        '7 is "G"...   need to go to col "V"
            Factor = (rng.Cells(EndRow, ColNo) - rng.Cells(StartRow, ColNo)) / Recs
    
            For RowNo = StartRow + 1 To EndRow - 1
                rng.Cells(RowNo, ColNo) = rng.Cells(StartRow, ColNo) + (RowNo - StartRow) * Factor
            Next RowNo
        Next ColNo
        
        StartRow = EndRow
        EndRow = FindNoEmpty(rng, StartRow + 1, "G")
    Loop
    
    MsgBox "Complete", vbInformation
End Sub
Function FindNoEmpty(rng As Range, ByVal StartRowNo As Long, ByVal Col As Variant) As Long
    Dim RowNo As Long
    
    If StartRowNo <= 0 Then
        Exit Function
    End If
    
    For RowNo = StartRowNo To rng.Rows.Count
        If Not IsEmpty(rng.Cells(RowNo, Col)) Then
            FindNoEmpty = RowNo
            Exit Function
        End If
    Next RowNo
        
    
End Function