Hello everyone,
the goal of my code is to:
Find "[term] - Competency" inside the sheet called "Data", and then:
1) Highlights the cell "[term] - Competency" in yellow
2) it looks for "[term] - [level of effort]" that has something written on the cell on the right from it.
3) Highlights the cell "[term] - [level of effort]" in purple
4) Copy the two cells on the right from it and pastes it next to "[term] - Competency"
This is the issue I am having:
Once the code has finished step 1, it is supposed to look for the cells below it and continue on step 2,3,4 But in the instances that it did not work, It identified the cell above it instead, which is empty, hence why it doesn't copy paste the details.
Instead of the cell identifying "Connect - Low Effort" that is below "Connect - Competency", it identified the cell that was above it.
I don't understand why it does identify the one above in certain instances and why it does not in other instances.
Here is my code:
Sub ListAreas()
Dim a, c, d, typ, FA
Columns(12).Insert
Range("L4") = "Sub Category"
For Each a In rAreas(Sheets("data").[B4])
With a.Columns(9).Cells
Set c = .Find("Competency", lookat:=xlPart)
FA = c.Address
Do
c.Select
If c.Offset(, 1) <> "" Then
c.Interior.ColorIndex = 6 'debug
typ = Trim(Split(c, "-")(0)) & " - " & c.Offset(, 1)
Set d = .Find(typ, lookat:=xlWhole)
If Not d Is Nothing Then
d.Interior.ColorIndex = 7 'debug
d.Offset(, 1).Copy c.Offset(, 2)
d.Offset(, 3).Copy c.Offset(, 3)
c.Offset(, 2).Resize(, 2).WrapText = True
c.Rows.AutoFit
End If
End If
Set c = .Find("Competency", after:=c, lookat:=xlPart)
Loop Until c.Address = FA
End With
Next a
End Sub
Function rAreas(Cel As Range)
'http://www.vbaexpress.com/forum/showthread.php?_
'60005-Store-rows-in-dictionary-or-collection&p=364471&viewfull=1#post364471
Dim oDict As Object
Dim rData As Range, rTemp As Range
Dim iRow As Long
Dim v As Variant
Dim sKey As String
Dim arr As Variant
Set oDict = CreateObject("Scripting.Dictionary")
oDict.comparemode = vbTextCompare
Set rData = Cel.CurrentRegion
rData.Select
For iRow = 2 To rData.Rows.Count
sKey = CStr(rData.Cells(iRow, 1).Value)
If oDict.exists(sKey) Then
Set rTemp = oDict(sKey)
Set rTemp = Union(rTemp, rData.Rows(iRow))
Set oDict(sKey) = rTemp
Else
oDict.Add sKey, rData.Rows(iRow)
End If
Next iRow
rAreas = oDict.items
Set oDict = Nothing
End FunctionThank you for your help in this important issue of mine 
I have attached a photo of the issue and the data sheet.