I need to label certain areas of a table. I need everything from “Run Start” to “Run End” to have a corresponding run number in a different column.
H (Run #) O (Activity_code) S (what I need) 1 Piping 1 Run Start - TBRT 1 1 OPS-RIH/POOH/Trip/Wiper Trip 1 1 OPS-Drilling 1 1 OPS-Surveying 1 1 RIG-OPS-RIH/POOH/Trip/Wiper Trip 1 1 Run End - TART 1 1 OPS BHA Config 1 Piping 2 Run Start - TBRT 2
I still haven’t fully figured out loops in VBA. Here is what I’ve come up with. I cant seem to find anything on this or get it working. Any help would be greatly appreciated.
For i = 2 To Worksheet1.UsedRange.Rows.Count If Worksheet1.Cells(i, o) = "Run S*" Then x = i If Worksheet.Cells(i, o).Value = "Run E*" Then Range("S" & x & ":" & "S" & i) = Range("H" & i).Value End If End If Exit For Next
If in your columns you have always have “Run Start” and “Run End” to define your labels, you could just use a solution like this (I assume the three columns are “A”, “B” and “C”):
Dim count As Integer: count = 2 'check the cell until it's empty Dim isrunning As Boolean: isrunning = False 'controls if the run has started but not ended Do While Range("B" & count) <> "" If isrunning = True Then Range("C" & count) = Range("A" & count) If Left(Range("B" & count),5) = "Run E" Then isrunning = False Else If Left(Range("B" & count),5) = "Run S" Then Range("C" & count) = Range("A" & count) isrunning = True End If End If count = count + 1 Loop
Please note that:
- This will stop when the cell in column “B” gets empty;
- I see you want to report the number from the column “A” to the column “C” if you are between a Run Start and a Run End (included), but correct me if I’m wrong.
You can try this:
Sub ject() Const what1 As String = "Run Start - TBRT" Const what2 As String = "Run End - TART" Application.ScreenUpdating = False With Sheets("Sheet1") '~~> change to suit Dim r As Range, lr As Long lr = .Range("A" & .Rows.Count).End(xlUp).Row Set r = .Range("A1", "C" & lr) '~~> assumes data is in A - C column Dim run, runs runs = GetFilters(r.Offset(1, 0).Resize(r.Rows.Count - 1, 1)) For Each run In runs Dim str As Range, enr As Range r.AutoFilter 1, run Set str = r.Find(what1): Set enr = r.Find(what2) If Not str Is Nothing And Not enr Is Nothing Then _ .Range(str, enr).Offset(0, 1).Value = run Next .AutoFilterMode = False End With Application.ScreenUpdating = True End Sub
Private Function GetFilters(source As Range) Dim c As Range If Not source Is Nothing Then With CreateObject("Scripting.Dictionary") For Each c In source.SpecialCells(xlCellTypeVisible).Cells If Not .Exists(c.Value) Then .Add c.Value, c.Value Next GetFilters = .Keys End With End If End Function
This ignores RUNS without end yet. If you want it considered, you can alter the If statement adding more conditions to it. HTH.