"Who is next?" sheet

[gavcuk]

Hi,

I'm something of an excel novice so may be biting off more than I can chew but looking to have a simple spreadsheet to identify which adviser is next up for a lead.

Currently we have a magnetic wipe board where we move a counter from name to name for several lead categories but would prefer to use some simple tech if we can so that all staff can see who is next regardless of whether they are in the office.

I'd like it so that a button can be clicked to move the counter to the next adviser once I've allocated them a lead.

If an adviser has status "holiday" on the sheet then they would miss their turn.

Is this achievable or unnecessarily complicated?

 

[Legacy 143009]

This macro will work with the following scenario. Create a standard module and paste this code. Assign the same macro to every button.

Sub buttonClick()
  Dim lRow As Long, lCol As Long, r As Long, c As Long, buttonName As String, a As Object
  Set a = Application

  With Worksheets("Sheet1")
  lRow = .Cells(Rows.Count, "A").End(xlUp).Row
  lCol = .Cells(2, Columns.Count).End(xlToLeft).Column
  For r = 3 To lRow
    If .Cells(r, "B").Value = "Hols" Then
      For c = 3 To lCol Step 2
        .Cells(r, c).Value = "H"
      Next
    End If
  Next
  buttonName = .Shapes(Application.Caller).TextFrame.Characters.Text
  c = a.Match(buttonName, .Rows(2), 0)
  If Not IsError(a.Match("X", .Columns(c), 0)) Then
    r = a.Match("X", .Columns(c), 0)
  Else
    Exit Sub
  End If
  .Cells(r, c).Value = ""
  r = IIf(.Cells((r Mod lRow) + 1, c).Value = "H", ((r + 1) Mod lRow) + 1, (r Mod lRow) + 1)
  If r < 3 Then
    r = 3
  End If
  .Cells(r, c).Value = "X"
  End With
End Sub

 

[gavcuk]

This macro will work with the following scenario. Create a standard module and paste this code. Assign the same macro to every button.View attachment 102799

Sub buttonClick()
  Dim lRow As Long, lCol As Long, r As Long, c As Long, buttonName As String, a As Object
  Set a = Application

  With Worksheets("Sheet1")
  lRow = .Cells(Rows.Count, "A").End(xlUp).Row
  lCol = .Cells(2, Columns.Count).End(xlToLeft).Column
  For r = 3 To lRow
    If .Cells(r, "B").Value = "Hols" Then
      For c = 3 To lCol Step 2
        .Cells(r, c).Value = "H"
      Next
    End If
  Next
  buttonName = .Shapes(Application.Caller).TextFrame.Characters.Text
  c = a.Match(buttonName, .Rows(2), 0)
  If Not IsError(a.Match("X", .Columns(c), 0)) Then
    r = a.Match("X", .Columns(c), 0)
  Else
    Exit Sub
  End If
  .Cells(r, c).Value = ""
  r = IIf(.Cells((r Mod lRow) + 1, c).Value = "H", ((r + 1) Mod lRow) + 1, (r Mod lRow) + 1)
  If r < 3 Then
    r = 3
  End If
  .Cells(r, c).Value = "X"
  End With
End Sub

Amazing, I'll give that a go.

Thanks so much!

 

[gavcuk]

Bingo, it works.

Thanks loads!

 

[Legacy 143009]

Gald it did work Thanks for the feedback

 

[gavcuk]

Gald it did work Thanks for the feedback

I did run into a problem if I marked two of the advisers as on hols. It works initially but then as the X advances to the bottom it fails.

Also, if I put Adviser 1 as on hols instead of 5, then once the X gets to the bottom i.e. Adviser 5 the X then moves to Adviser 1 instead of skipping them (as they are away) and moving to Adviser 2.

Any idea, what is causing that?

 

[Legacy 143009]

I see.. Both problems are caused by the same reason. I tried to fix it. I am not in front of the computer. I had no chance to test. Please let me know if it works. I'll check later.

Sub buttonClick()
  Dim lRow As Long, lCol As Long, r As Long, c As Long, buttonName As String, a As Object
  Set a = Application

  With Worksheets("Sheet1")
  lRow = .Cells(Rows.Count, "A").End(xlUp).Row
  lCol = .Cells(2, Columns.Count).End(xlToLeft).Column
  For r = 3 To lRow
    If .Cells(r, "B").Value = "Hols" Then
      For c = 3 To lCol Step 2
        .Cells(r, c).Value = "H"
      Next
    End If
  Next
  buttonName = .Shapes(Application.Caller).TextFrame.Characters.Text
  c = a.Match(buttonName, .Rows(2), 0)
  If Not IsError(a.Match("X", .Columns(c), 0)) Then
    r = a.Match("X", .Columns(c), 0)
  Else
    Exit Sub
  End If
  .Cells(r, c).Value = ""
  Do
    r = IIf((r Mod lRow) + 1 < 3, 3 ,(r Mod lRow) + 1)
  Loop While .Cells(r, c).Value = "H"
  .Cells(r, c).Value = "X"
  End With
End Sub

 

[gavcuk]

I see.. Both problems are because of the same reason. I tried to fix it. I am not in front of the computer. I had no chance to test. Please let me know if it works. I'll check later.

Sub buttonClick()
  Dim lRow As Long, lCol As Long, r As Long, c As Long, buttonName As String, a As Object
  Set a = Application

  With Worksheets("Sheet1")
  lRow = .Cells(Rows.Count, "A").End(xlUp).Row
  lCol = .Cells(2, Columns.Count).End(xlToLeft).Column
  For r = 3 To lRow
    If .Cells(r, "B").Value = "Hols" Then
      For c = 3 To lCol Step 2
        .Cells(r, c).Value = "H"
      Next
    End If
  Next
  buttonName = .Shapes(Application.Caller).TextFrame.Characters.Text
  c = a.Match(buttonName, .Rows(2), 0)
  If Not IsError(a.Match("X", .Columns(c), 0)) Then
    r = a.Match("X", .Columns(c), 0)
  Else
    Exit Sub
  End If
  .Cells(r, c).Value = ""
  Do
    r = IIf((r Mod lRow) + 1 < 3, 3 ,(r Mod lRow) + 1)
  Loop While .Cells(r, c).Value = "H"
  .Cells(r, c).Value = "X"
  End With
End Sub

Working like a charm!

Thank you!

 

[Legacy 143009]

You are welcome Thanks for the feedback Also you can use the code below. Basically it the same code but a bit cleaner:

Sub buttonClick()
  Dim lRow As Long, lCol As Long, r As Long, c As Long, buttonName As String, a As Object
  Set a = Application

  With Worksheets("Sheet1")
  lRow = .Cells(Rows.Count, "A").End(xlUp).Row
  lCol = .Cells(2, Columns.Count).End(xlToLeft).Column
  For r = 3 To lRow
    If .Cells(r, "B").Value = "Hols" Then
      For c = 3 To lCol Step 2
        .Cells(r, c).Value = "H"
      Next
    End If
  Next
  buttonName = .Shapes(Application.Caller).TextFrame.Characters.Text
  c = a.Match(buttonName, .Rows(2), 0)
  If Not IsError(a.Match("X", .Columns(c), 0)) Then
    r = a.Match("X", .Columns(c), 0)
    .Cells(r, c).Value = ""
    Do
      r = IIf((r Mod lRow) + 1 < 3, 3 ,(r Mod lRow) + 1)
    Loop While .Cells(r, c).Value = "H"
    .Cells(r, c).Value = "X"
  End If
  End With
End Sub

 

[gavcuk]

You are welcome Thanks for the feedback Also you can use the code below. Basically it the same code but a bit cleaner:

Sub buttonClick()
  Dim lRow As Long, lCol As Long, r As Long, c As Long, buttonName As String, a As Object
  Set a = Application

  With Worksheets("Sheet1")
  lRow = .Cells(Rows.Count, "A").End(xlUp).Row
  lCol = .Cells(2, Columns.Count).End(xlToLeft).Column
  For r = 3 To lRow
    If .Cells(r, "B").Value = "Hols" Then
      For c = 3 To lCol Step 2
        .Cells(r, c).Value = "H"
      Next
    End If
  Next
  buttonName = .Shapes(Application.Caller).TextFrame.Characters.Text
  c = a.Match(buttonName, .Rows(2), 0)
  If Not IsError(a.Match("X", .Columns(c), 0)) Then
    r = a.Match("X", .Columns(c), 0)
    .Cells(r, c).Value = ""
    Do
      r = IIf((r Mod lRow) + 1 < 3, 3 ,(r Mod lRow) + 1)
    Loop While .Cells(r, c).Value = "H"
    .Cells(r, c).Value = "X"
  End If
  End With
End Sub

That also seems to work so thank you.

One thing I've noticed is that when someone is marked as Hols in the status column, clicking a button also puts a H in the submitted column. Can that be prevented?

Feel bad for asking tbh