Arranging data that is in columns in a different dynamic way

Hi Okami

I am making some progress however have 2 issues:

1. If there are no candidates with codes NN or SS (for e.g.), then the code is not liking that and I am getting an error. It's looking for atleast one candidate with a combination of NN, SS, NS or SN but it could be the case that no candidates exist in one of the groups (at a given point in the year as the list/codes is always changing). Otherwise it works fine.

2. Is it possible to 'fix' the array regions in columns B:C and F:G because if there is any data/text in column D for e.g. the code is not liking that either and I get an error. Also if there is any data in Cell Y45 (once cell above where it says Group 1) the code does not like that either. It is possible I may have data in these cells and didn't realise it would be an issue.


Also if I wanted my lists enclosed in a border would I add something like ...

Code:

---

Cells.Borders().LineStyle = xlContinuous

---

Thanks you very much once again

Hi branston!
Fixed 1 and 2 and border's requirements.
About position I'll take time to look at it.
But I don't think it's a good way to do it. There will still be problems in the future.

Code:

---

Sub Okami()
Dim arrOri, arrRst, d As Object, i&, c, cnt&, rng As Range, r&, rTop&, rBtm&
Set d = CreateObject("scripting.dictionary")
'--------Search------------------------------------------
rTop = Columns("b").Find("GROUP 2").Row + 1
rBtm = Cells(rTop, 2).End(4).Row
arrOri = Range(Cells(rTop, 2), Cells(rBtm, 3))
ReDim arrRst(1 To UBound(arrOri), 2)
For i = 1 To UBound(arrOri)
  If arrOri(i, 2) = "N" Then d(arrOri(i, 1)) = ""
Next i
rTop = Columns("f").Find("GROUP 2").Row + 1
rBtm = Cells(rTop, 6).End(4).Row
arrOri = Range(Cells(rTop, 6), Cells(rBtm, 7))
For i = 1 To UBound(arrOri)
  If arrOri(i, 2) = "N" Then
    If d.exists(arrOri(i, 1)) Then
      cnt = cnt + 1
      arrRst(cnt, 0) = cnt
      arrRst(cnt, 1) = arrOri(i, 1)
      Set rng = Sheets("DATA").Columns("b").Find(arrOri(i, 1), lookat:=xlWhole)
      If Not rng Is Nothing Then arrRst(cnt, 2) = rng.Offset(, 1) & ".jpg" Else arrRst(cnt, 2) = "xxxxx.jpg"
    End If
  End If
Next i
If cnt = 0 Then MsgBox "No candidates exist in this group.": Exit Sub
'--------Search------------------------------------------


'--------Output------------------------------------------
rTop = Columns("y").Find("group 1").Row
rBtm = Columns("y").Find("group 3").Row
r = rBtm - rTop - 8
Range("x" & rTop + 1 & ":z" & Cells(rBtm - 2, "y").End(3).Row) = ""
Columns("y").Find("group 1").CurrentRegion.Offset(1) = ""
If cnt > r Then Cells(Columns("y").Find("group 3").Row - 7, "x").Resize(cnt - r + 1, 8).Insert Shift:=xlDown
Set rng = Cells(Columns("y").Find("group 1").Row + 1, "x").Resize(cnt, 3)
rng = arrRst
rng.Columns(1).Interior.Color = vbYellow
rng.Borders().LineStyle = xlContinuous
'--------Output------------------------------------------
End Sub

---

Thanks Okami

Not sure why I am getting an error here

Code:

---

Columns("y").Find("group 1").CurrentRegion.Offset(1) = ""

---

"Object variable or With block variable not set" ... everything looks ok????????

I'm sorry I forgot to delete that code line.

Sorry still getting same error on last few lines of code and don't know why

Code:

---

Set rng = Cells(Columns("y").Find("group 1").Row + 1, "x").Resize(cnt, 3)

---

Code:

---

Columns("y").Find("group 1").Row

---

There is only one possible mistake in this sentence.
Verify if "group 1" of column Y has been deleted. Or they become capital letters. Not sure.

Have had a good look at it but cannot see why getting the error. I think it's the way it's searching for Group1??

I've attached an example sheet. Could you please take a look ?

Thank you

Hi branston!
Yeah, I didn't think the number of rows would go wrong without data.
I have revised the code. Please try again.
only one line:

Code:

---

Range("x" & rTop + 1 & ":z" & Application.Max(Cells(rBtm - 2, "y").End(3).Row, rTop + 1)) = ""

---

BTW: I don't know why I can't upload attachments.

--Okami

Thanks Okami - that seems to have fixed that bit.

I seem to be having an issue with the groups3 and 4 moving but will try to fix it and come back if I need help.

Thanks again for all your help.

Okami if you have a look at the attached file you will see that when the Group 1 list is very long, Group 3 AND Group 4 auto-adjust. However when Group 2 is very long (and group 1 may be short ... you can change the codes in columns c and g to N and S etc.), only Group 4 auto-adjusts and Group 3 stays where it is. I don't understand as using the same code really for each group?

1)Group1 and group2 should have the same extension.

Code:

---

If cnt > r Then Cells(Columns("ad").Find("group 4").Row - 7, "x").Resize(cnt - r + 1, 8).Insert Shift:=xlDown

---

2）If there is nothing under group3 and group4, you can simplify the code.

Thanks Okami. That works 99% so will do for now.

For error checking purposes I need to do a count of candidates in all 4 lists. Obviously the lists change in length. Is this easy to do using an excel formula e.g. (countA(lookup 'group 1' + last row)) or would I have to use VBA because of the "lastrow" search?

Thanks again for all your help!