Donate. I desperately need donations to survive due to my health

Get paid by answering surveys Click here

Click here to donate

Remote/Work from Home jobs

Copy stream data in a column down to and including a text value to paste to a column in another sheet, start again from after text value and paste

I apologize for being such a Noob but that's what I am and I need to do some advanced things with VBA and Excel. I look to this community as the helping experts and appreciate any help I get.

This seems like it would be an easy thing but I am struggling to get the desired results. But I have made some progress.

In Sheet2, I have a simple data stream of values coming in from a connection to a continually updating value table filling up successive rows. Once the values have come they do not normally change.

In Sheet2 column "O:O" contains results from math performed on the incoming data table rows. This is simulated in the linked sheet. The basic result is a number with "0.000" format with the exception of two occasional text values. "Stop" and "Station". These text strings can be anywhere in O:O and are always the same text.

Each time a new value shows up in the table, the resulting values from the first calculation row in Column "O:O" down to and including the first text value need to be copied to a block range in Sheet1 starting at C21, named "Run_1_Start".

Once that has been done the next and subsequent calculated numeric values need to be copied to a new block range starting at C35, Named "Run_2_Start", until the second instance of text value. The process repeats with the each data sample copied to Next block range starting Cell.

I can get and post the cell address of each text value in Sheet2 P:P adjacent cell with the first code. With the second code I can reliably paste the data without duplicates where it needs to go. I have manually assigned worksheet named ranges to the calculated data in Sheet2 which needs to be done in VBA if it is to be used.

I have also manually assigned named cells at the start of each Sheet1 block to be pasted to which can remain static. using a Named Range in Sheet1 i.e "Block1", caused the anomaly of if the copied data from Sheet2 was 7 cells, or half of the Sheet1 named range of 14 cells it would paste the same data twice, filling up the named range in Sheet1 with duplicates.

If I could use VBA to name the range in Sheet2, "Run_1" from the start, O2, to each new data result each time it comes in O:O down to the occurrence of a Text value, Pasting that to a named cell in Sheet1 "Run_1_Start" cell. Have the first Named range in Sheet2 remain from O2 to including the first text string, then start naming the next numeric value/s in Sheet2 O:O "Run_2" pasting that to down to the next occurrence of a Text value to Sheet1 "Run_2_Start" cell.

The addresses in Sheet2 P:P and all pasted data in Sheet1 C21:C can be erased to watch what I have work in the linked sheet bellow. Any Help would be greatly appreciated.

Get and place in P:P the Cell Address of Stop or Station in O:O

Sub GetCellAddy()
'Find all instances of "Stop" and "Station" in Sheet2 Column O:O then paste the cell name in adjacent cell in ColumnP:P
'Stop Updating, Alerts, Events and Calcs for speed and fewer VBA Crashes
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Worksheets(2).Select
row_count = 220  ' the number of rows in your range
For r = 1 To row_count
    If Cells(r, 15) = "Stop" Then
        Cells(r, 16) = Cells(r, 15).Address
    End If
Next r
For r = 1 To row_count
    If Cells(r, 15) = "Station" Then
        Cells(r, 16) = Cells(r, 15).Address
    End If
Next r
    'Restart Updating, Alerts, Events and Calcs after code completes
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Copy Paste Code

'This could work if I can write code to Name the range fron start to first "Stop" then fron the cell below first "Stop" to next "Stop" etc.
Sub PasteNamedRange()
'Stop Updating, Alerts, Events and Calcs for speed and fewer VBA Crashes.
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

          ' Run the Error handler "ErrHandler" when an error occurs.
          On Error GoTo Errhandler

    Worksheets(2).Range("Run_1").Copy
    Worksheets(1).Range("Run_1_Start").PasteSpecial Paste:=xlPasteValues, 
    Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False 'Problem: when a range that is half of the Named Block size I paste to i.e.. Block1 on Sheet1, it pastes it twice.
    Application.CutCopyMode = False
    Worksheets(2).Range("Run_2").Copy
    Worksheets(1).Range("Run_2_Start").PasteSpecial Paste:=xlPasteValues, 
    Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Worksheets(2).Range("Run_3").Copy
    Worksheets(1).Range("Run_3_Start").PasteSpecial Paste:=xlPasteValues, 
    Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
    Worksheets(2).Range("Run_4").Copy
    Worksheets(1).Range("Run_4_Start").PasteSpecial Paste:=xlPasteValues, 
    Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Worksheets(2).Range("Run_5").Copy
    Worksheets(1).Range("Run_5_Start").PasteSpecial Paste:=xlPasteValues, 
    Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Worksheets(2).Range("Run_6").Copy
    Worksheets(1).Range("Run_6_Start").PasteSpecial Paste:=xlPasteValues, 
    Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Put more copy lines here if I learn code to name ranges in Sheet2 based on the above search that works well

    'Restart Updating, Alerts, Events and Calcs after code completes.
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

    Worksheets(2).Select
    Range("A1").Select
    Application.CutCopyMode = False
    Worksheets(1).Select
    Range("A1").Select
    Application.CutCopyMode = False

    Errhandler:
        Worksheets(2).Select
        Range("A1").Select
        Application.CutCopyMode = False
        Worksheets(1).Select
        Range("A1").Select
        Application.CutCopyMode = False
        'Restart Updating, Alerts, Events and Calcs after code Error.
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
        Exit Sub

            'Restart Updating, Alerts, Events and Calcs after code Error.
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

https://drive.google.com/file/d/1ndFYMhpehClTcYmP_o7d8OhLfhFYrgVh/view?usp=sharing

Comments