3 Attachment(s)
compare dynamic arrays and copy data from another array into a cell in WS
this is a wee bit complicated so I have included the code I have already and commented all of it which hopefully will explain what I am trying to achive. I have also included examples of the worksheets I am using, the "final assignments" worksheet I have included one which is essentially "blank" and another which is an example of what it should look like when it is "filled out". hopefully this is enough for someone to be able to advise what I need to do to achieve the end result if not let me know what else you need to know. I have tried loads of stuff over the last few days but to be honest I am at a total loss as to what to do and the syntax to use. Thank you in advance for looking, and any help you may be able to give me.
Code:
Option Explicit
Sub Copy_picked_sidesmen_to_final_56()
Dim SelectedName() As Variant 'this array holds the "SelectedName" for a specific date
Dim AllNames() As Variant 'this array holds all the names in the "Final Assignments"
Dim NameCount1 As Long, NameCount2 As Long 'namecount 1 holds a count of the "SelectedName", namecount 2 holds a count of "AllNames" in the "Final Assignments"
Dim Services() As Variant 'this array holds a list of all the "Services"
Dim Columncounter As Long 'this array holds a count of all the columns that have "Services"
Dim NameCell As String 'this string holds the location of the cell in "Final Assignments" where the "SelectedName" appears
' this counter can also be used to determin how many columns of selected names there are as number of services and columns of selected names for each date will always be equal
Sheets("Final Assignments").Select 'select "Final Assignments" worksheet
Columncounter = Range("B3", Range("B3").End(xlToRight)).Cells.Count 'set range of "Services" to count
ReDim Services(0 To Columncounter) 'Redimension the "Services" array
For Columncounter = LBound(Services) To UBound(Services) 'set upper and lower bounds of the array
Services(Columncounter) = Range("B3").Offset(0, Columncounter).Value 'collect the values
Next Columncounter 'increament along the row
Sheets("Sorted sidesmen").Select 'select "Sorted sidesmen" worksheet
NameCount1 = Range("A61", Range("A61").End(xlDown)).Count - 1 'count the number of names for the first date
ReDim SelectedName(0 To NameCount1) 'Redimension the "SelectedName" array
For NameCount1 = LBound(SelectedName, 1) To UBound(SelectedName, 1) 'set upper and lower bounds of the array
SelectedName(NameCount1) = Range("A61").Offset(NameCount1).Value 'collect the values
Next NameCount1 'increament down the column
Sheets("Final Assignments").Select 'select "Final Assignments" worksheet
NameCount2 = Range("A4", Range("A4").End(xlDown)).Count - 1 'count the number of "AllNames" in the "Final Assignments"
ReDim AllNames(0 To NameCount2) 'Redimension the "AllNames" array
For NameCount2 = LBound(AllNames, 1) To UBound(AllNames, 1) 'set upper and lower bounds of the array
AllNames(NameCount2) = Range("A4").Offset(NameCount2).Value 'collect the values
'1 this is where I need check where the "SelectedName" appears in the "AllNames" array and record
' the cell reference where that name appears in final assignments,
'2 then offset one cell to the right and place the value of the first item in the services array in that cell
'3 then go to the next name in the "SelectedName" list and do the same again until the "SelectedName" list is complete
'4 then I need to go back to "Sorted sidesmen" move 1 column to the right and read the next list of names and perform action 1 again
' then action 2 but this time move 2 cells to the right
' action 4 again but this time 2 columns to the right
'so on and so on until the “Columncounter” is "0"
End Sub
this is what it should look like when it's finished
Attachment 22255
this is what it starts out like
Attachment 22256
this is the data I am working with
Attachment 22257
