controlling excel cells and writing it to other cells - excel

Question

I have a excel sheet like at below. I want to find some strings in my excel's third cell. The string is 180 days. When the cell value includes 180 days, I want write previous cells value in next to empty cells like in below picture. I want to write process plan in first cell, operation title in second cell. I wrote this codes but it's not working like what I want.
Sub Button1_Click()
Dim excelRange As Long
Dim i As Long
Dim k As Long
'Dim txt As String
excelRange = ActiveSheet.Cells(1048576, 3).End(xlUp).Row
k = 2
For a = 2 To excelRange
txt = Cells(a, 3)
k = a
If InStr(1, txt, "180 days") > 0 Then
For i = a To 2 Step -1
txt1 = Cells(i, 3)
If InStr(1, txt1, "Oper Title") > 0 Then
Cells(a, 2) = Cells((k + 1), 3)
ElseIf InStr(1, txt1, "Process") > 0 Then
Cells(a, 1) = Cells(k, 3)
Else:
k = k - 1
End If
Next i
End If
Next a
End Sub

Answer 1

Sub test()
Dim excelRange As Range
Dim criteriRange As Range
Dim evaluateRange As Range
Dim c As Range
Dim i As Long
Set excelRange = Range("C1:C" & Cells(1048576, 3).End(xlUp).Row)
For Each cell In excelRange
If UCase(cell.Text) Like "*180 DAY*" Then
If criteriRange Is Nothing Then
Set criteriRange = cell
Else
Set criteriRange = Union(criteriRange, cell)
End If
End If
Next
If Not criteriRange Is Nothing Then
For Each c In criteriRange
For i = c.Row To 1 Step -1
If UCase(Cells(i, 3)) Like "*PROCESS PLAN*" Then
c.Offset(0, -2) = Cells(i, 3)
Exit For
End If
Next
For i = c.Row To 1 Step -1
If UCase(Cells(i, 3)) Like "*OPER TITLE*" Then
c.Offset(0, -1) = Cells(i + 1, 3)
Exit For
End If
Next
Next
End If
End Sub

Answer 2

Instead of looping through a range, your macro will run much faster if you use the Range.Find method.
In your code, you did not check to ensure that all of your sets of Process | Title | 180 Days are complete. I added that to the code below, by making sure that the Process and Title rows were found after the previous 180 day row (or before the 180 day row for the first instance).
In your code, you did not check to see if the cells where you want to output this information are, in fact, empty. If you really want to do that, you can easily modify this code to check these cells before writing to them.
Hopefully, through the comments and the use of meaningful variable names, you will be able to understand what is going on. But you might want to also read through VBA Help for the Range.Find method.
In general, we search down to find the 180 day row, then search up from there to find the associated Process and Title rows.
If a preceding Process or Title row should be before the preceding 180 day row, then we have an incomplete set, output the error message, and terminate the procedure.
If necessary, you could develop procedures to deal with incomplete data sets.
Option Explicit
Sub Info()
Dim searchRng As Range, C As Range, cProcessPlan As Range, cOperTitle As Range
Dim firstAddress As String 'to check when we are done
Dim lastAddress As String 'to check for incomplete data sets
'Where are we looking?
Set searchRng = ThisWorkbook.Worksheets("Sheet1").Columns(3)
With searchRng
Set C = .Find(what:="180 Days", after:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlPart, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:=False)
If Not C Is Nothing Then
firstAddress = C.Address
lastAddress = C.Address
Set cOperTitle = .Find(what:="Oper Title", after:=C, searchdirection:=xlPrevious)
Set cProcessPlan = .Find(what:="Process Plan", after:=C, searchdirection:=xlPrevious)
If Not cOperTitle Is Nothing Or Not cProcessPlan Is Nothing Then
'check for full set
If cOperTitle.Row > Range(lastAddress).Row Or cProcessPlan.Row > Range(lastAddress).Row Then
MsgBox "Incomplete Data Set" & vbLf & "Before: " & C.Address
Exit Sub
End If
C.Offset(0, -1) = cOperTitle.Offset(1, 0)
C.Offset(0, -2) = cProcessPlan
Else
MsgBox "Title or Process Plan not found"
Exit Sub
End If
Do
Set C = .Find(what:="180 Days", after:=C, LookIn:=xlValues, _
lookat:=xlPart, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:=False)
If C.Address = firstAddress Then Exit Do
Set cOperTitle = .Find(what:="Oper Title", after:=C, searchdirection:=xlPrevious)
Set cProcessPlan = .Find(what:="Process Plan", after:=C, searchdirection:=xlPrevious)
'check for a full set
If cOperTitle.Row < Range(lastAddress).Row Or cProcessPlan.Row < Range(lastAddress).Row Then
MsgBox "Incomplete Data Set" & vbLf & "Between: " & lastAddress & " and " & C.Address
Exit Sub
End If
C.Offset(0, -1) = cOperTitle.Offset(1, 0)
C.Offset(0, -2) = cProcessPlan
lastAddress = C.Address
Loop
End If
End With
'next stuff
End Sub

Answer 3

Using a variant array is fast.
Sub test()
Dim Ws As Worksheet
Dim rngDB As Range
Dim vDB As Variant
Dim vRow(), vTitle(), vProcess()
Dim i As Long, j As Long, k As Long, m As Long
Set Ws = ActiveSheet
With Ws
Set rngDB = .Range("a1", .Range("c" & Rows.Count).End(xlUp))
End With
vDB = rngDB
For i = 1 To UBound(vDB, 1)
If InStr(vDB(i, 3), "180 days") Then
j = j + 1
ReDim Preserve vRow(1 To j)
vRow(j) = i
ElseIf InStr(vDB(i, 3), "Oper Title") Then
k = k + 1
ReDim Preserve vTitle(1 To k)
vTitle(k) = vDB(i + 1, 3)
ElseIf InStr(vDB(i, 3), "Process") Then
m = m + 1
ReDim Preserve vProcess(1 To m)
vProcess(m) = vDB(i, 3)
End If
Next i
For i = 1 To j
vDB(vRow(i), 1) = vProcess(i)
vDB(vRow(i), 2) = vTitle(i)
Next i
rngDB = vDB
End Sub