• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA to assign reviewers

krkr2784

New Member
Hi All,

I'm looking for a way to assign reviewers to submitted papers using a few criteria:
  1. submitted papers and reviewers match on a keyword related to the research field
  2. each reviewer is assigned no more than 4 total reviews
  3. each submitted paper is assigned 3 different reviewers that match on the keyword
I've tried to do this with INDEX & AGGREGATE functions, but I can't seem to avoid a circular reference error when trying to ensure criteria 2, above. Would love some help and guidance on this!! Thank you.
 

Attachments

  • ReviewerAssignments.xlsx
    18.7 KB · Views: 19
Hi,​
according to your attachment try this demonstration (v4) :​
Code:
Sub Demo1()
            Const D = "¤"
            Dim V, VR(), L&, C&, R&, U&, W(1), F&
    With Sheet4.[A1].CurrentRegion.Columns(1)
            Range(.Cells(3), .Cells(.Cells.Count)).Sort .Cells(3), xlAscending, Header:=xlNo
           .AdvancedFilter xlFilterCopy, , .Range("K1"), True
        With .Range("K1").CurrentRegion
            If .Count < 3 Then .Clear: Beep: Exit Sub
            V = Range(.Cells(3), .Cells(.Count)).Value2
           .Clear
        End With
            ReDim VR(1 To UBound(V), 1)
        For L = 1 To UBound(V)
            With .Range(.Find(V(L, 1), , , xlWhole), .Find(V(L, 1), , , , , xlPrevious)).Columns
                If .Rows.Count = 1 Then
                    VR(L, 0) = Array(.Item(2).Value2)
                    VR(L, 1) = Array(.Item(4).Value2)
                Else
                    VR(L, 0) = Filter(Application.Transpose(.Item(2)), "", True)
                    VR(L, 1) = Filter(Application.Transpose(.Item(4)), "", True)
                End If
            End With
        Next
    End With
    With Sheet3.[A1].CurrentRegion.Rows
            C = .Columns.Count - 2:  If C < 1 Then Beep: Exit Sub
            Application.ScreenUpdating = False
           .Item("3:" & .Count).Columns(3).Resize(, C).Clear
            V = Application.Match(.Columns(1), V, 0)
        For R = 3 To .Count
            If IsNumeric(V(R, 1)) Then
                   U = UBound(VR(V(R, 1), 0))
                If U > -1 Then
                    If U < C Then
                       .Cells(R, 3).Resize(, U + 1).Value2 = VR(V(R, 1), 0)
                        For L = 0 To U:  VR(V(R, 1), 1)(L) = VR(V(R, 1), 1)(L) - 1:  Next
                    Else
                       .Cells(R, 3).Resize(, C).Value2 = VR(V(R, 1), 0)
                        For L = 0 To C - 1:  VR(V(R, 1), 1)(L) = VR(V(R, 1), 1)(L) - 1:  Next
                        W(0) = VR(V(R, 1), 0):  W(1) = VR(V(R, 1), 1)
                        For L = 0 To U - C:  VR(V(R, 1), 0)(L) = W(0)(C + L):  VR(V(R, 1), 1)(L) = W(1)(C + L):  Next
                        For F = 0 To C - 1:  VR(V(R, 1), 0)(F + L) = W(0)(F):  VR(V(R, 1), 1)(F + L) = W(1)(F):  Next
                    End If
                        F = 0
                    For L = 0 To U
                        If VR(V(R, 1), 1)(L) < 1 Then F = 1: VR(V(R, 1), 0)(L) = D: VR(V(R, 1), 1)(L) = D
                    Next
                        If F Then For L = 0 To 1: VR(V(R, 1), L) = Filter(VR(V(R, 1), L), D, False): Next
                End If
            End If
        Next
    End With
            Application.ScreenUpdating = True
End Sub
Do you like it ? So thanks to click on bottom right Like !​
 
Hi Marc,

I've just been testing this for my first real data set! I have noticed that sometimes when I try to add reviewers, I receive an error when I run the script to assign reviewers to submissions with the same research field.

I've successfully added 90% of my reviewers with their "fields" (listed in column A) and matched them with submissions. However, occasionally certain values in the "field" column seem to cause an error and I cannot ascertain why this happens. Below is the error message and the debug window showing additional detail. Are you able to help? Thank you in advance! :)

73804
73805
 
Last edited by a moderator:
According to the highlighted codeline it seems the issue comes from the worksheet Reviewers column #2​
as it looks weird if a field has a single reviewer to assign (not the case in your attachment) ?​
 
Ah, I understand! Yes, this isn't represented in the test data in my original attachment. As I was beginning to use real data, I only had one reviewer signed up for a new field and that would have caused the error. After adding a second reviewer in that field, as you indicated, the error was resolved. Thank you so much!
 
Last edited by a moderator:
Yes, when there is no rule within the initial post so the rules come from the attachment, here a field must have at least two reviewers …​
Do you need a mod to accept only a single reviewer or a message to point out the issue rather than a VBA error ?​
 
Back
Top