I wonder if anyone can help out with this one.
I have a ws that has a list of people with their availability through the month, the first part of the code builds an array of people with their corresponding status, available or not
the second part cycles through the names and if they are available places their name in the corresponding date column in the second sheet, at the moment it places their name in exactly the same place in the second sheet as it was in the first sheet which results in a lot of blank cells, so the third part of the code removes all the blank cells.
However I want the code to place the names in the first available cell in each of the date columns as it cycles through, is this possible and if so can anyone suggest a way of doing it. It if the activecell.offset line that needs to be changed but I am struggling with what it should look like
the reason I need to do this is because there are buttons further down the second sheet which further sort people into various shifts and of course if I remove the blank cells all the buttons move up the sheet as well, making a right mess.
thank you for your time
this is my code
Option Explicit
Sub Copy_all_available_names_to_sorted_sidesmen_50()
'record all the names and availability into a single array
Dim AllData() As Variant
Dim Name As Long, Status As Long
Dim Storedname As String
Dim Storedstatus As String
Dim nameindex As Long
Sheets("Everyones Availability").Select
Name = Range("A3", Range("A3").End(xlDown)).Count - 1
Status = Range("a3", Range("a3").End(xlToRight)).Count - 1
ReDim AllData(0 To Name, 0 To Status)
For Name = LBound(AllData, 1) To UBound(AllData, 1)
For Status = LBound(AllData, 2) To UBound(AllData, 2)
AllData(Name, Status) = Range("A3").Offset(Name, Status).Value
Next Status
Next Name
Sheets("Sorted sidesmen").Select
Range("A3").Select
For Name = LBound(AllData, 1) To UBound(AllData, 1)
For Status = LBound(AllData, 2) To UBound(AllData, 2)
Storedname = AllData(Name, 0)
Storedstatus = AllData(Name, Status)
If Storedstatus = "Available" Then
ActiveCell.Offset(1, 0)(Name, Status).Value = Storedname
End If
Next Status
Next Name
Dim rng As Range
On Error GoTo NoBlanksFound
Set rng = Range("a3:z46").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
rng.Rows.Delete shift:=xlShiftUp
NoBlanksFound:
MsgBox "All Blanks have been removed"
End Sub
I have a ws that has a list of people with their availability through the month, the first part of the code builds an array of people with their corresponding status, available or not
the second part cycles through the names and if they are available places their name in the corresponding date column in the second sheet, at the moment it places their name in exactly the same place in the second sheet as it was in the first sheet which results in a lot of blank cells, so the third part of the code removes all the blank cells.
However I want the code to place the names in the first available cell in each of the date columns as it cycles through, is this possible and if so can anyone suggest a way of doing it. It if the activecell.offset line that needs to be changed but I am struggling with what it should look like
the reason I need to do this is because there are buttons further down the second sheet which further sort people into various shifts and of course if I remove the blank cells all the buttons move up the sheet as well, making a right mess.
thank you for your time
this is my code
Option Explicit
Sub Copy_all_available_names_to_sorted_sidesmen_50()
'record all the names and availability into a single array
Dim AllData() As Variant
Dim Name As Long, Status As Long
Dim Storedname As String
Dim Storedstatus As String
Dim nameindex As Long
Sheets("Everyones Availability").Select
Name = Range("A3", Range("A3").End(xlDown)).Count - 1
Status = Range("a3", Range("a3").End(xlToRight)).Count - 1
ReDim AllData(0 To Name, 0 To Status)
For Name = LBound(AllData, 1) To UBound(AllData, 1)
For Status = LBound(AllData, 2) To UBound(AllData, 2)
AllData(Name, Status) = Range("A3").Offset(Name, Status).Value
Next Status
Next Name
Sheets("Sorted sidesmen").Select
Range("A3").Select
For Name = LBound(AllData, 1) To UBound(AllData, 1)
For Status = LBound(AllData, 2) To UBound(AllData, 2)
Storedname = AllData(Name, 0)
Storedstatus = AllData(Name, Status)
If Storedstatus = "Available" Then
ActiveCell.Offset(1, 0)(Name, Status).Value = Storedname
End If
Next Status
Next Name
Dim rng As Range
On Error GoTo NoBlanksFound
Set rng = Range("a3:z46").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
rng.Rows.Delete shift:=xlShiftUp
NoBlanksFound:
MsgBox "All Blanks have been removed"
End Sub
