
Originally Posted by
joseph_pat
Hi David, thankyou for your help,
i keep getting a error: "compile error sub or function not defined" and a yellow arrow point to "Sub ListData()"
Sorry, A typo crept in. Replace with this:
Sub ListData()
Sheets("WEEKS").Select
Dim tsArray() 'Declare the Time Sheet Array
Dim sRange As Range 'Declare the sort range (for array output)
Dim sKey As Range 'Declare the sort key (for array output)
ReDim tsArray(1 To 500, 1 To 7) 'Define the dimensions of array - 500 rows X 7 columns
tsAr = 1 'First row of array
head = Cells(1, 3) 'Heading found on row 1
LastRow = Cells(Rows.Count, "A").End(xlUp).Row 'Find the last row on the WEEKS sheet
For c = 3 To 37 Step 5 'Loop through days - increase by 5 columns each loop
For r = 2 To LastRow + 5 'Loop through every row on the sheet.
If Cells(r, 3) = head Then GoTo 100 'Ignore rows which match the heading
If IsDate(Cells(r, c)) Then 'If there is a date, record it, and skip the next row.
dte = Cells(r, c)
r = r + 2
End If
If IsEmpty(Cells(r, c)) Then GoTo 100 'If the cell is empty, go to the next row.
If Not IsDate(Cells(r, c)) Then 'If the cell is does not contain a date, it must be
tsArray(tsAr, 1) = dte 'data to be recorded, so store the date twice. 1 is date
tsArray(tsAr, 2) = dte '2 is day.
tsArray(tsAr, 3) = Cells(r, 1) 'Get the name from column 1
tsArray(tsAr, 4) = Cells(r, c) 'Get the site from current column
tsArray(tsAr, 5) = Cells(r, c + 2) 'Get the start time from 2 cells to the right
tsArray(tsAr, 6) = Cells(r, c + 3) 'Get the finish time from 3 cells to the right
tsArray(tsAr, 7) = Cells(r, c + 4) 'Get the total hours from 4 cells to the right
tsAr = tsAr + 1 'Increase the array row number by 1
End If
100:
Next r 'Move to the next row (this is repeated until Last Row is reached
Next c 'Move to the next day - increase column number by 5
'When all days have been worked on - write the result to the PROPOSAL sheet.
Sheets("Proposal").Select '
[A1] = head 'Place the heading at the top of the sheet
Range("A3:G500").ClearContents 'Clear any previous data
Range("A3:G500") = tsArray 'Write the data in the array
Set sRange = Range("A2:G500") 'Assign the Range for sorting
Set sKey = Range("A3") 'Assign the sort key
sRange.Sort Key1:=sKey, Order1:=xlAscending, Header:=xlYes 'Sort the data by date
End Sub
DAC
Bookmarks