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 Function
Thank you for your help in this important issue of mine
I have attached a photo of the issue and the data sheet.