PDA

View Full Version : compare dynamic arrays and copy data from another array into a cell in WS



wilverley
05-17-2018, 03:10 AM
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.


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

22255

this is what it starts out like

22256

this is the data I am working with
22257

SamT
05-17-2018, 06:38 AM
Please attach a workbook. We are not going to look at your pictures and recreate your data by hand to test the code.

Use the Go Advanced button, and at the bottom of that page, the Manage Attachments button to upload a workbook

wilverley
05-17-2018, 11:58 PM
I have attached the entire workbook, please excuse my mistake this is the first time I have used this site and was not aware of the protocol.