I have Frequency value in column A and corresponding Gain value in column B, Phase value in column C. Frequency ranges from 10 to 1e06 whereas gain varies from 100 to -100 and phase varies from 180 to -180. In cell D1 I want value of frequency (fc) where gain crosses 0 and in cell D2 I want phase value at fc. I used macro shared in Run brute force on a column to identify if the values cross over a point using VBA. But I am not able to access the value of frequency where gain cross 0. I need help in writing code to access that value at particular cell.
This is the macro I am using to detect zero crossing.
Sub Tester()
Dim sht As Worksheet, lastRow As Long, xvals, yvals, r As Long
Dim th As Double, y1, y2, x1, x2
Set sht = ActiveSheet
lastRow = sht.Range("B" & Rows.Count).End(xlUp).Row
'assumes y vals in "B" and x vals in "A"
'adjust as rtequired...
yvals = sht.Range(sht.Cells(14, "B"), sht.Cells(lastRow, "B"))
xvals = sht.Range(sht.Cells(14, "A"), sht.Cells(lastRow, "A"))
th = 0
For r = 1 To UBound(yvals) - 1
y1 = yvals(r, 1)
y2 = yvals(r + 1, 1)
'pair of points crosses the threshold?
If IsNumeric(y1) And IsNumeric(y2) Then
If (y1 < th And y2 > th) Or (y1 > th And y2 < th) Then
x1 = xvals(r, 1)
x2 = xvals(r + 1, 1)
'*************
'calculate the intercept
'*************
End If
End If
Next r
End Sub
Sample Data
I wish you had posted a sample of the data to see how the data is changing. Perhaps a logarithmic scale is more appropriate for the frequency.
If you are looking for one zero point, update your code as below.
Sub Tester()
Dim sht As Worksheet, lastRow As Long, xvals, yvals, r As Long
Dim th As Double, y1, y2, x1, x2
Dim zvals, z1, z2, z0, x0 ' added
Set sht = ActiveSheet
lastRow = sht.Range("B" & Rows.Count).End(xlUp).Row
'assumes y vals in "B" and x vals in "A"
'adjust as rtequired...
yvals = sht.Range(sht.Cells(14, "B"), sht.Cells(lastRow, "B"))
xvals = sht.Range(sht.Cells(14, "A"), sht.Cells(lastRow, "A"))
zvals = sht.Range("C14:C" & lastRow).Value ' added
th = 0
For r = 1 To UBound(yvals) - 1
y1 = yvals(r, 1)
y2 = yvals(r + 1, 1)
'pair of points crosses the threshold?
If IsNumeric(y1) And IsNumeric(y2) Then
If (y1 < th And y2 > th) Or (y1 > th And y2 < th) Then
x1 = xvals(r, 1)
x2 = xvals(r + 1, 1)
z1 = zvals(r, 1) ' added
z2 = zvals(r + 1, 1) ' added
'*************
'calculate the intercept
'*************
x0 = (x2 * y1 - x1 * y2 + th * (x1 - x2)) / (y1 - y2) ' added
z0 = (x2 * z1 - x1 * z2 + x0 * (z2 - z1)) / (x2 - x1) ' added
sht.Range("D1").Value = x0 ' added
sht.Range("D2").Value = z0 ' added
Exit For ' added
End If
End If
Next r
End Sub