Changing Avaya Agent Skills with Excel VBA

N0 DICE

New Member
Joined
Oct 22, 2010
Messages
5
I have a code that I was using to change agent skills with VBA. It turns out that the code is to large and I get a compile error. Procedure too large. Can anyone help me with a way to shorten it or possible modify it with a loop of some sort?

This is a piece of the code; I need it to repeat the SetArr piece 700 times. If anyone has any insights they would be greatly appreciated. Also I can send the excel workbook if anyone would like to take a look. It is kinda large (20 Mb)

Code:
Sub ChangeSkills()

Dim agents As String
Dim cvsApp As Object
Dim cvsConn As Object
Dim cvsSrv As Object
Dim SetArr() As Variant
Dim sWarn As String
Dim Skills() As Variant
Dim nSkills As String


Set cvsApp = CreateObject("ACSUP.cvsApplication")
Set cvsConn = CreateObject("ACSCN.cvsConnection")
Set cvsSrv = CreateObject("ACSUPSRV.cvsServer")



UserName = "***"
Password = "****"
AvayaIP = "*****"

If cvsApp.CreateServer(UserName, Password, "", AvayaIP, False, "ENU", cvsSrv, cvsConn) Then
If cvsConn.Login(UserName, Password, AvayaIP, "ENU") Then

On Error Resume Next
Set AgMngObj = cvsSrv.AgentMgmt

ReDim SetArr(12, 3)
SetArr(1, 1) = Range("B2").Value
SetArr(1, 2) = Range("B3").Value
SetArr(1, 3) = 0
SetArr(2, 1) = Range("C2").Value
SetArr(2, 2) = Range("C3").Value
SetArr(2, 3) = 0
SetArr(3, 1) = Range("D2").Value
SetArr(3, 2) = Range("D3").Value
SetArr(3, 3) = 0
SetArr(4, 1) = Range("E2").Value
SetArr(4, 2) = Range("E3").Value
SetArr(4, 3) = 0
SetArr(5, 1) = Range("F2").Value
SetArr(5, 2) = Range("F3").Value
SetArr(5, 3) = 0
SetArr(6, 1) = Range("G2").Value
SetArr(6, 2) = Range("G3").Value
SetArr(6, 3) = 0
SetArr(7, 1) = Range("H2").Value
SetArr(7, 2) = Range("H3").Value
SetArr(7, 3) = 0
SetArr(8, 1) = Range("I2").Value
SetArr(8, 2) = Range("I3").Value
SetArr(8, 3) = 0
SetArr(9, 1) = Range("J2").Value
SetArr(9, 2) = Range("J3").Value
SetArr(9, 3) = 0
SetArr(10, 1) = Range("K2").Value
SetArr(10, 2) = Range("K3").Value
SetArr(10, 3) = 0
SetArr(11, 1) = Range("L2").Value
SetArr(11, 2) = Range("L3").Value
SetArr(11, 3) = 0
SetArr(12, 1) = Range("M2").Value
SetArr(12, 2) = Range("M3").Value
SetArr(12, 3) = 0

sWarn = ""
agents = Range("A2").Value
nSkills = Range("A3").Value

AgMngObj.AcdStartUp -1, "", cvsSrv.ServerKey, -1
AgMngObj.OleAgentSetSkill 1, "" & agents & "", 1, 0, 0, 0, nSkills, SetArr, sWarn ' note the nSKills for # of skills in SetArr

On Error Resume Next
Set AgMngObj = cvsSrv.AgentMgmt

ReDim SetArr(12, 3)
SetArr(1, 1) = Range("B4").Value
SetArr(1, 2) = Range("B5").Value
SetArr(1, 3) = 0
SetArr(2, 1) = Range("C4").Value
SetArr(2, 2) = Range("C5").Value
SetArr(2, 3) = 0
SetArr(3, 1) = Range("D4").Value
SetArr(3, 2) = Range("D5").Value
SetArr(3, 3) = 0
SetArr(4, 1) = Range("E4").Value
SetArr(4, 2) = Range("E5").Value
SetArr(4, 3) = 0
SetArr(5, 1) = Range("F4").Value
SetArr(5, 2) = Range("F5").Value
SetArr(5, 3) = 0
SetArr(6, 1) = Range("G4").Value
SetArr(6, 2) = Range("G5").Value
SetArr(6, 3) = 0
SetArr(7, 1) = Range("H4").Value
SetArr(7, 2) = Range("H5").Value
SetArr(7, 3) = 0
SetArr(8, 1) = Range("I4").Value
SetArr(8, 2) = Range("I5").Value
SetArr(8, 3) = 0
SetArr(9, 1) = Range("J4").Value
SetArr(9, 2) = Range("J5").Value
SetArr(9, 3) = 0
SetArr(10, 1) = Range("K4").Value
SetArr(10, 2) = Range("K5").Value
SetArr(10, 3) = 0
SetArr(11, 1) = Range("L4").Value
SetArr(11, 2) = Range("L5").Value
SetArr(11, 3) = 0
SetArr(12, 1) = Range("M4").Value
SetArr(12, 2) = Range("M5").Value
SetArr(12, 3) = 0

sWarn = ""
agents = Range("A4").Value
nSkills = Range("A5").Value

AgMngObj.AcdStartUp -1, "", cvsSrv.ServerKey, -1
AgMngObj.OleAgentSetSkill 1, "" & agents & "", 1, 0, 0, 0, nSkills, SetArr, sWarn ' note the nSKills for # of skills in SetArr

On Error Resume Next
Set AgMngObj = cvsSrv.AgentMgmt

ReDim SetArr(12, 3)
SetArr(1, 1) = Range("B6").Value
SetArr(1, 2) = Range("B7").Value
SetArr(1, 3) = 0
SetArr(2, 1) = Range("C6").Value
SetArr(2, 2) = Range("C7").Value
SetArr(2, 3) = 0
SetArr(3, 1) = Range("D6").Value
SetArr(3, 2) = Range("D7").Value
SetArr(3, 3) = 0
SetArr(4, 1) = Range("E6").Value
SetArr(4, 2) = Range("E7").Value
SetArr(4, 3) = 0
SetArr(5, 1) = Range("F6").Value
SetArr(5, 2) = Range("F7").Value
SetArr(5, 3) = 0
SetArr(6, 1) = Range("G6").Value
SetArr(6, 2) = Range("G7").Value
SetArr(6, 3) = 0
SetArr(7, 1) = Range("H6").Value
SetArr(7, 2) = Range("H7").Value
SetArr(7, 3) = 0
SetArr(8, 1) = Range("I6").Value
SetArr(8, 2) = Range("I7").Value
SetArr(8, 3) = 0
SetArr(9, 1) = Range("J6").Value
SetArr(9, 2) = Range("J7").Value
SetArr(9, 3) = 0
SetArr(10, 1) = Range("K6").Value
SetArr(10, 2) = Range("K7").Value
SetArr(10, 3) = 0
SetArr(11, 1) = Range("L6").Value
SetArr(11, 2) = Range("L7").Value
SetArr(11, 3) = 0
SetArr(12, 1) = Range("M6").Value
SetArr(12, 2) = Range("M7").Value
SetArr(12, 3) = 0

sWarn = ""
agents = Range("A6").Value
nSkills = Range("A7").Value

AgMngObj.AcdStartUp -1, "", cvsSrv.ServerKey, -1
AgMngObj.OleAgentSetSkill 1, "" & agents & "", 1, 0, 0, 0, nSkills, SetArr, sWarn ' note the nSKills for # of skills in SetArr

On Error Resume Next
Set AgMngObj = cvsSrv.AgentMgmt

ReDim SetArr(12, 3)
SetArr(1, 1) = Range("B8").Value
SetArr(1, 2) = Range("B9").Value
SetArr(1, 3) = 0
SetArr(2, 1) = Range("C8").Value
SetArr(2, 2) = Range("C9").Value
SetArr(2, 3) = 0
SetArr(3, 1) = Range("D8").Value
SetArr(3, 2) = Range("D9").Value
SetArr(3, 3) = 0
SetArr(4, 1) = Range("E8").Value
SetArr(4, 2) = Range("E9").Value
SetArr(4, 3) = 0
SetArr(5, 1) = Range("F8").Value
SetArr(5, 2) = Range("F9").Value
SetArr(5, 3) = 0
SetArr(6, 1) = Range("G8").Value
SetArr(6, 2) = Range("G9").Value
SetArr(6, 3) = 0
SetArr(7, 1) = Range("H8").Value
SetArr(7, 2) = Range("H9").Value
SetArr(7, 3) = 0
SetArr(8, 1) = Range("I8").Value
SetArr(8, 2) = Range("I9").Value
SetArr(8, 3) = 0
SetArr(9, 1) = Range("J8").Value
SetArr(9, 2) = Range("J9").Value
SetArr(9, 3) = 0
SetArr(10, 1) = Range("K8").Value
SetArr(10, 2) = Range("K9").Value
SetArr(10, 3) = 0
SetArr(11, 1) = Range("L8").Value
SetArr(11, 2) = Range("L9").Value
SetArr(11, 3) = 0
SetArr(12, 1) = Range("M8").Value
SetArr(12, 2) = Range("M9").Value
SetArr(12, 3) = 0

sWarn = ""
agents = Range("A8").Value
nSkills = Range("A9").Value

AgMngObj.AcdStartUp -1, "", cvsSrv.ServerKey, -1
AgMngObj.OleAgentSetSkill 1, "" & agents & "", 1, 0, 0, 0, nSkills, SetArr, sWarn ' note the nSKills for # of skills in SetArr

On Error Resume Next
Set AgMngObj = cvsSrv.AgentMgmt

ReDim SetArr(12, 3)
SetArr(1, 1) = Range("B10").Value
SetArr(1, 2) = Range("B11").Value
SetArr(1, 3) = 0
SetArr(2, 1) = Range("C10").Value
SetArr(2, 2) = Range("C11").Value
SetArr(2, 3) = 0
SetArr(3, 1) = Range("D10").Value
SetArr(3, 2) = Range("D11").Value
SetArr(3, 3) = 0
SetArr(4, 1) = Range("E10").Value
SetArr(4, 2) = Range("E11").Value
SetArr(4, 3) = 0
SetArr(5, 1) = Range("F10").Value
SetArr(5, 2) = Range("F11").Value
SetArr(5, 3) = 0
SetArr(6, 1) = Range("G10").Value
SetArr(6, 2) = Range("G11").Value
SetArr(6, 3) = 0
SetArr(7, 1) = Range("H10").Value
SetArr(7, 2) = Range("H11").Value
SetArr(7, 3) = 0
SetArr(8, 1) = Range("I10").Value
SetArr(8, 2) = Range("I11").Value
SetArr(8, 3) = 0
SetArr(9, 1) = Range("J10").Value
SetArr(9, 2) = Range("J11").Value
SetArr(9, 3) = 0
SetArr(10, 1) = Range("K10").Value
SetArr(10, 2) = Range("K11").Value
SetArr(10, 3) = 0
SetArr(11, 1) = Range("L10").Value
SetArr(11, 2) = Range("L11").Value
SetArr(11, 3) = 0
SetArr(12, 1) = Range("M10").Value
SetArr(12, 2) = Range("M11").Value
SetArr(12, 3) = 0

sWarn = ""
agents = Range("A10").Value
nSkills = Range("A11").Value

AgMngObj.AcdStartUp -1, "", cvsSrv.ServerKey, -1
AgMngObj.OleAgentSetSkill 1, "" & agents & "", 1, 0, 0, 0, nSkills, SetArr, sWarn ' note the nSKills for # of skills in SetArr

Set AgMngObj = Nothing
Else

End If
End If

Set cvsApp = Nothing
Set cvsConn = Nothing
Set cvsSrv = Nothing

cvsConn.Logout
cvsConn.Disconnect


End Sub
 
Does each group have 21 Skills ?
If they don't ,does the each group number of skills stay consistent. At least for long periods of time? ( ie your 21 skills for MSC SS mrb team 1 how often does there template skills change if it does ? )

If so please provide me with

How many skills each group has :

1 = 21
2 = ??
ect
Tyger0951


1) could use a sheet shared in sharepoint

2) sounds good

3) total of 130 agents, largest group 50

4) is there any difference in the scripts between interactive and scheduled scripts?

Thanks for your efforts


FYI just about done with full code after this info .
 
Last edited:
Upvote 0

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Completed the code. Uses code to add group and skill template for each group . A test function to be able to test that each groups is pulling correct skill template. And code to run through all groups listed . The sheets are code named so will have to do the same unless you would like the workbook and can send me a PM with your email to send it to you.






Code:
Dim NewGroupName As Range
Dim NewGroupSkill As Range
Dim NewGroupPrt As Range
Dim NumSkills As Integer
Dim NumPrt As Integer
Dim I As Integer
Dim Startpoint As Integer


Sub ChangeAllSkills()
 
Dim Agents As String
Dim cvsApp As Object
Dim cvsConn As Object
Dim cvsSrv As Object
Dim SetArr() As Variant
Dim sWarn As String
Dim Skills() As Variant
Dim myrange As Range
Dim GrpName As String


Set cvsApp = CreateObject("ACSUP.cvsApplication")
Set cvsConn = CreateObject("ACSCN.cvsConnection")
 
  
Set cvsSrv = cvsApp.Servers(1) ' Uses current avayacms open Note if you get blanks on skilling ensuure to manually gate an agent this stores the info in the active avaya instance
 
Surl = "C:\Users\" & Environ$("Username") & "\Desktop\AgentList.HTML" 'Location to save file  < Update to your save location
Set myrange = wsGroupNames.Range("A2", Range("A2").End(xlDown)) ' Sets length of group names.
 
For Each Cell In myrange
ActiveCell = Cell
Set GrpName = Cell.value  ' Sets grpname for later to pull correct skills


If Cell = "" Then Exit Sub


   cvsSrv.Dictionary.ACD = 1
   Set Info = cvsSrv.Dictionary.Reports("Dictionary\\Agent Group Members")
' possible to move create report out of for to use all same window need to test
       b = cvsSrv.Dictionary.CreateReport(Info, Rep) 'Opens Report window
       If b Then
          Rep.SetProperty "Agent Group", "" & Cell & ""  ' In puts the Group Name into blank
         b = Rep.SaveHTML("" & Surl & "", False, "") ' Saves List of agent names and id to Location specified in Surl
          Rep.Quit ' Closes Window
              If Not cvsSrv.Interactive Then cvsSrv.ActiveTasks.Remove Rep.TaskID
          Set Rep = Nothing ' clears rep so could be used again
       End If
Set Info = Nothing
 
' Pull Data from Saved Location
 
Worksheets.Add.Name = "AgentList" ' Addes new worksheet
Sheets("AgentList").Select ' Makes active sheet for query
 
With ActiveSheet.QueryTables.Add(Connection:= _
       "URL;file:///C:/Users/" & environ$("Username") & "/Desktop/ReskillTest/Agentlist.HTML", Destination _
        :=Range("$A$1")) ' Update to Surl location
        .Name = "AgentList"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
   
 
Application.ScreenUpdating = False ' Turns off screenupdating to make update to sheet faster
  
 
Range("b2").Select 'Selects first id
 
For Each Item In Range("B2:B900") ' Range of id's
ActiveCell.Offset(1, 0).EntireRow.Insert ' Insert Row
ActiveCell.Offset(1, 0).Value = ";"  ' add ;
ActiveCell.Offset(2, 0).Select ' Selects next id or possible next
        If ActiveCell = "" Then
        ActiveCell.Offset(-1, 0).Delete
        Exit For  ' If no then delete previous ; and move on
    End If
    Next Item
 
Range("c2").Select 'Selects Cell to paste agent ids in correct format
 
  ActiveCell.Formula = "=CONCATENATE(B2,B3,B4,B5,B6,B7,B8,B9,B10,B11,B12,B13,B14,B15,B16,B17,B18,B19,B20,B21,B22,B23,B24,B25,B26,B27,B28,B29,B30,B31,B32,B33,B34,B35,B36,B37,B38,B39,B40,B41,B42,B43,B44,B45,B46,B47,B48,B49,B50,B51,B52,B53,B54,B55,B56,B57,B58,B59,B60,B61,B62,B63,B64,B65,B66,B67,B68,B69,B70,B71,B72,B73,B74,B75,B76,B77,B78,B79,B80,B81,B82,B83,B84,B85,B86,B87,B88,B89,B90,B91,B92,B93,B94,B95,B96,B97,B98,B99,B100,B101) " ' Formula to combine ids and ; for gating list
 
Application.ScreenUpdating = True ' Turns back on screenupdating
 


 wsGates.Activate ' Sets Gating Page as active page to search
NumSkills = Cells.Find(GrpName & " NumSkills ").Offset(0, 1).Value ' Finds the number of skills for group
Startpoint = Cells.Find(GrpName & " Skill List ").Row ' Finds which cell to start to pull from array


ReDim SetArr(NumSkills, 3)
For I = Startpoint To Startpoint   ' Sets starting point B2 for array
    For j = 1 To NumSkills
        SetArr(j, 1) = Cells(I, j + 1).Value
        SetArr(j, 2) = Cells(I + 1, j + 1).Value
        SetArr(j, 3) = 0
    Next
    Next
 
 
Agents = Sheets("AgentList").Range("C2").Value 'Uses agent id list in correct id;id;id format
 
Set AgMngObj = cvsSrv.AgentMgmt
AgMngObj.AcdStartUp -1, "", cvsSrv.ServerKey, -1
AgMngObj.OleAgentSetSkill 1, "" & Agents & "", 1, 0, 0, 0, NumSkills, SetArr, "
 
 Sheets("AgentList").Delete
 


Cell.Offset(1, 0).Select


MsgBox ("Continue to next group?") ' remove to make continious
 
 Next   ' starts next group
 
Set AgMngObj = Nothing
Set cvsApp = Nothing
Set cvsConn = Nothing
Set cvsSrv = Nothing
 
End Sub
 
  
Sub AddNewGroup()


wsGroupNames.Select


Set NewGroupName = wsGroupNames.Range("a1").End(xlDown).Offset(1, 0)
Set NewGroupSkill = wsGates.Range("b2").End(xlDown).Offset(1, 0)
Set NewGroupPrt = wsGates.Range("b2").End(xlDown).Offset(2, 0)


NewGroupName = InputBox("What is the the Group Name?") ' Gets New Group Name




NumSkills = InputBox("How Many Skills") ' Asks how many skils
NumPrt = NumSkills ' Sets same number of skills and prts


wsGates.Range("a1").End(xlDown).Offset(1, 0).Value = NewGroupName & " Skill List "  ' Adds groups new skill list
wsGates.Range("a1").End(xlDown).Offset(1, 0).Value = NewGroupName & " PRT List " ' Adds groups new priority list
wsGates.Range("a1").End(xlDown).Offset(1, 0).Value = NewGroupName & " NumSkills " ' Adds groups new priority list


NewGroupSkill.Offset(2, 0).Value = NumSkills


' Loops Through to Get all skills and Priorities
    For I = 0 To NumSkills - 1
        NewGroupSkill.Offset(0, I).Value = Application.InputBox(prompt:="Skill" & I + 1, Title:=I + 1)
        NewGroupPrt.Offset(0, I).Value = Application.InputBox(prompt:="Priority" & I + 1, Title:=I + 1)
    Next I


End Sub


















Sub TestSetGates()
Dim j As Integer
Dim SetArr() As Variant
Dim GrpName As String


GrpName = Application.InputBox(prompt:="Group Name")






 wsGates.Activate
NumSkills = Cells.Find(GrpName & " NumSkills ").Offset(0, 1).Value
Startpoint = Cells.Find(GrpName & " Skill List ").Row


ReDim SetArr(NumSkills, 3)
For I = Startpoint To Startpoint  ' Sets starting point B2 for array
    For j = 1 To NumSkills
        SetArr(j, 1) = Cells(I, j + 1).Value
        SetArr(j, 2) = Cells(I + 1, j + 1).Value
        SetArr(j, 3) = 0
    Next
    Next
    
    
    
 On Error Resume Next
Sheets.Add.Name = "test"
 Sheets("test").Range("A1:z4") = WorksheetFunction.Transpose(SetArr)






End Sub
 
Last edited:
Upvote 0
Just noticed might want to add/move Dim J as Integer to top of code since not present for first macro .
Completed the code. Uses code to add group and skill template for each group . A test function to be able to test that each groups is pulling correct skill template. And code to run through all groups listed . The sheets are code named so will have to do the same unless you would like the workbook and can send me a PM with your email to send it to you.






Code:
Dim NewGroupName As Range
Dim NewGroupSkill As Range
Dim NewGroupPrt As Range
Dim NumSkills As Integer
Dim NumPrt As Integer
Dim I As Integer
Dim Startpoint As Integer


Sub ChangeAllSkills()
 
Dim Agents As String
Dim cvsApp As Object
Dim cvsConn As Object
Dim cvsSrv As Object
Dim SetArr() As Variant
Dim sWarn As String
Dim Skills() As Variant
Dim myrange As Range
Dim GrpName As String


Set cvsApp = CreateObject("ACSUP.cvsApplication")
Set cvsConn = CreateObject("ACSCN.cvsConnection")
 
  
Set cvsSrv = cvsApp.Servers(1) ' Uses current avayacms open Note if you get blanks on skilling ensuure to manually gate an agent this stores the info in the active avaya instance
 
Surl = "C:\Users\" & Environ$("Username") & "\Desktop\AgentList.HTML" 'Location to save file  < Update to your save location
Set myrange = wsGroupNames.Range("A2", Range("A2").End(xlDown)) ' Sets length of group names.
 
For Each Cell In myrange
ActiveCell = Cell
Set GrpName = Cell.value  ' Sets grpname for later to pull correct skills


If Cell = "" Then Exit Sub


   cvsSrv.Dictionary.ACD = 1
   Set Info = cvsSrv.Dictionary.Reports("Dictionary\\Agent Group Members")
' possible to move create report out of for to use all same window need to test
       b = cvsSrv.Dictionary.CreateReport(Info, Rep) 'Opens Report window
       If b Then
          Rep.SetProperty "Agent Group", "" & Cell & ""  ' In puts the Group Name into blank
         b = Rep.SaveHTML("" & Surl & "", False, "") ' Saves List of agent names and id to Location specified in Surl
          Rep.Quit ' Closes Window
              If Not cvsSrv.Interactive Then cvsSrv.ActiveTasks.Remove Rep.TaskID
          Set Rep = Nothing ' clears rep so could be used again
       End If
Set Info = Nothing
 
' Pull Data from Saved Location
 
Worksheets.Add.Name = "AgentList" ' Addes new worksheet
Sheets("AgentList").Select ' Makes active sheet for query
 
With ActiveSheet.QueryTables.Add(Connection:= _
       "URL;file:///C:/Users/" & environ$("Username") & "/Desktop/ReskillTest/Agentlist.HTML", Destination _
        :=Range("$A$1")) ' Update to Surl location
        .Name = "AgentList"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
   
 
Application.ScreenUpdating = False ' Turns off screenupdating to make update to sheet faster
  
 
Range("b2").Select 'Selects first id
 
For Each Item In Range("B2:B900") ' Range of id's
ActiveCell.Offset(1, 0).EntireRow.Insert ' Insert Row
ActiveCell.Offset(1, 0).Value = ";"  ' add ;
ActiveCell.Offset(2, 0).Select ' Selects next id or possible next
        If ActiveCell = "" Then
        ActiveCell.Offset(-1, 0).Delete
        Exit For  ' If no then delete previous ; and move on
    End If
    Next Item
 
Range("c2").Select 'Selects Cell to paste agent ids in correct format
 
  ActiveCell.Formula = "=CONCATENATE(B2,B3,B4,B5,B6,B7,B8,B9,B10,B11,B12,B13,B14,B15,B16,B17,B18,B19,B20,B21,B22,B23,B24,B25,B26,B27,B28,B29,B30,B31,B32,B33,B34,B35,B36,B37,B38,B39,B40,B41,B42,B43,B44,B45,B46,B47,B48,B49,B50,B51,B52,B53,B54,B55,B56,B57,B58,B59,B60,B61,B62,B63,B64,B65,B66,B67,B68,B69,B70,B71,B72,B73,B74,B75,B76,B77,B78,B79,B80,B81,B82,B83,B84,B85,B86,B87,B88,B89,B90,B91,B92,B93,B94,B95,B96,B97,B98,B99,B100,B101) " ' Formula to combine ids and ; for gating list
 
Application.ScreenUpdating = True ' Turns back on screenupdating
 


 wsGates.Activate ' Sets Gating Page as active page to search
NumSkills = Cells.Find(GrpName & " NumSkills ").Offset(0, 1).Value ' Finds the number of skills for group
Startpoint = Cells.Find(GrpName & " Skill List ").Row ' Finds which cell to start to pull from array


ReDim SetArr(NumSkills, 3)
For I = Startpoint To Startpoint   ' Sets starting point B2 for array
    For j = 1 To NumSkills
        SetArr(j, 1) = Cells(I, j + 1).Value
        SetArr(j, 2) = Cells(I + 1, j + 1).Value
        SetArr(j, 3) = 0
    Next
    Next
 
 
Agents = Sheets("AgentList").Range("C2").Value 'Uses agent id list in correct id;id;id format
 
Set AgMngObj = cvsSrv.AgentMgmt
AgMngObj.AcdStartUp -1, "", cvsSrv.ServerKey, -1
AgMngObj.OleAgentSetSkill 1, "" & Agents & "", 1, 0, 0, 0, NumSkills, SetArr, "
 
 Sheets("AgentList").Delete
 


Cell.Offset(1, 0).Select


MsgBox ("Continue to next group?") ' remove to make continious
 
 Next   ' starts next group
 
Set AgMngObj = Nothing
Set cvsApp = Nothing
Set cvsConn = Nothing
Set cvsSrv = Nothing
 
End Sub
 
  
Sub AddNewGroup()


wsGroupNames.Select


Set NewGroupName = wsGroupNames.Range("a1").End(xlDown).Offset(1, 0)
Set NewGroupSkill = wsGates.Range("b2").End(xlDown).Offset(1, 0)
Set NewGroupPrt = wsGates.Range("b2").End(xlDown).Offset(2, 0)


NewGroupName = InputBox("What is the the Group Name?") ' Gets New Group Name




NumSkills = InputBox("How Many Skills") ' Asks how many skils
NumPrt = NumSkills ' Sets same number of skills and prts


wsGates.Range("a1").End(xlDown).Offset(1, 0).Value = NewGroupName & " Skill List "  ' Adds groups new skill list
wsGates.Range("a1").End(xlDown).Offset(1, 0).Value = NewGroupName & " PRT List " ' Adds groups new priority list
wsGates.Range("a1").End(xlDown).Offset(1, 0).Value = NewGroupName & " NumSkills " ' Adds groups new priority list


NewGroupSkill.Offset(2, 0).Value = NumSkills


' Loops Through to Get all skills and Priorities
    For I = 0 To NumSkills - 1
        NewGroupSkill.Offset(0, I).Value = Application.InputBox(prompt:="Skill" & I + 1, Title:=I + 1)
        NewGroupPrt.Offset(0, I).Value = Application.InputBox(prompt:="Priority" & I + 1, Title:=I + 1)
    Next I


End Sub


















Sub TestSetGates()
Dim j As Integer
Dim SetArr() As Variant
Dim GrpName As String


GrpName = Application.InputBox(prompt:="Group Name")






 wsGates.Activate
NumSkills = Cells.Find(GrpName & " NumSkills ").Offset(0, 1).Value
Startpoint = Cells.Find(GrpName & " Skill List ").Row


ReDim SetArr(NumSkills, 3)
For I = Startpoint To Startpoint  ' Sets starting point B2 for array
    For j = 1 To NumSkills
        SetArr(j, 1) = Cells(I, j + 1).Value
        SetArr(j, 2) = Cells(I + 1, j + 1).Value
        SetArr(j, 3) = 0
    Next
    Next
    
    
    
 On Error Resume Next
Sheets.Add.Name = "test"
 Sheets("test").Range("A1:z4") = WorksheetFunction.Transpose(SetArr)






End Sub
 
Upvote 0

Forum statistics

Threads
1,225,156
Messages
6,183,246
Members
453,152
Latest member
ChrisMd

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top