Finding specific cell and then giving each number above and below it a different value, resetting timelime

[MRTX7005]

I am struggling with the VBA code that uses a cell value from Sheet 2 as a row number on Sheet 1. This row number along with a specific column on Sheet 1 finds a specific cell on sheet 1. Everything above and below the "found cell" would be given a new value. I am basically trying to reset a timeline data series to have new zero point.

Sheet 2 has a cell with a numeric value in it. Call this cell C3.

Sheet 1 has a series of data that is used to create a graph. One of the columns on Sheet 1 represents a timeline. Call this Column A. The time increment between cells is 0.025 seconds.

I am trying to find the cell: Sheet 1 Column A, Row from value of Sheet 2 C3. Once this is found, the value of that cell would be reset to equal 0.000. Anything above that cell would be offset by a negative time increment. Anything below would be a position. The length of the data in Column A varies.

For example, Sheet 1 has the following data.
A
1 Time
2 6.000
3 6.025
4 6.050
5 6.075
6 6.100
7 6.125
8 6.150
9 6.175
.
.
.

Say Sheet 2 C3 = 5. I am trying to find the cell Sheet 1 column A, row 5 and set that cell value to equal 0.000. The numbers above and below are then changed. The final result would like the table below with the new time values.
A
1 Time
2 -0.075
3 -0.050
4 -0.025
5 0.000
6 0.025
7 0.050
8 0.075
9 0.100
.
.
.


Any help would be appreciated.
MR

 

[igold]

Try this:

Sub ChangeTime()
    
    Dim ws1 As Worksheet: Set ws1 = Worksheets("Sheet1")
    Dim colA As Range
    Dim lRow As Long, tgt As Long, x As Long, stp As Long
    Dim inc As Single
    
    lRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    tgt = Worksheets("Sheet2").Range("C3").Value
    inc = 0.025
    stp = 1
    Set colA = Range("A1:A" & lRow)
    colA.NumberFormat = "0.000"
    colA.Cells(tgt).Value = 0
        For x = tgt - 1 To 2 Step -1
            colA.Cells(x).Value = -inc * stp
            stp = stp + 1
        Next
    stp = 1
        For x = tgt + 1 To lRow
            colA.Cells(x).Value = inc * stp
            stp = stp + 1
        Next
    
End Sub

 

[Peter_SSs]

You could also try this on a copy of your workbook.

Sub ResetTimeline()
  Dim LastRow As Long, RowNum As Long
  
  With Sheets("Sheet1")
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    RowNum = Sheets("Sheet2").Range("C3").Value
    If RowNum > 1 And RowNum < LastRow Then
      With .Range("A2:A" & LastRow)
        .Value = Evaluate(.Address & "-" & .Cells(RowNum - 1).Value)
      End With
    End If
  End With
End Sub