Sanchaz
08-01-2007, 05:28 PM
Hi. I'm at it again...trying to do something I don't know how to!
Anywho, I found a couple of pieces of code on this site that got me VERY close to what I want to accomplish (thanks to you all), but I'm having trouble massaging it to do what I want.:whip
I have a set of project worksheets which are all formatted the same way (if I can keep my boss from changing them): same headers, same number of columns, all headers are in row 3 of worksheet, etc.
Here are the things I want to do:
For each worksheet:
insert the worksheet name into the next available empty row in the Summary Report worksheet
add headers for each worksheet extract
copy rows to the Summary Report worksheet only if the date in the Deadline column falls w/in a date range.
skip a row in the Summary Report worksheet between each data setI've added comments in the code where I think the actions should take place. I've also attached the file I'm trying to automate. (OK, so the worksheets aren't all the same right now and they all don't have data, but I'm working with what I have now and will sync things before I finalize the project.)
Can someone help me put all the pieces together?
I'd be ever SOOOO GRATEFUL!!!!!
Here's the code I'm using:
Sub CreateSummaryReport()
Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim trg As Worksheet 'Summary Report Worksheet
Dim rng As Range 'Range object
Dim colCount As Integer 'Column count in tables in the worksheets
Set wrk = ActiveWorkbook 'Working in active workbook
'Checks for an existing Summary report and displays a msg if there is
For Each sht In wrk.Worksheets
If sht.Name = "Summary Report" Then
MsgBox "There is a worksheet called as 'Summary Report'." & vbCrLf & _
"Please remove or rename this worksheet since 'Summary Report' would be" & _
"the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
Exit Sub
End If
Next sht
'We don't want screen updating
Application.ScreenUpdating = False
'Add new worksheet as the last worksheet
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
'Rename the new worksheet
trg.Name = "Summary Report"
'Point to first worksheet in workbook
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(1, 255).End(xlToLeft).Column
'Start loop
For Each sht In wrk.Worksheets
'If worksheet in loop is the last one, stop execution (it is Summary Report worksheet)
If sht.Index = wrk.Worksheets.Count Then
Exit For
End If
'Skip a row in Summary Report worksheet
'Put sheet name in next available cell in column A of Summary Report
'Retrieve column headers and put them in Summary Report (always in row 3 of worksheet)
'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
'copy only those rows that match preset date range
'If value in column E >= Date And value in column E <= Date + 7 Then
'copy the row
'Put data into the Master worksheet
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Next sht
'Resize the columns in Summary Report worksheet
trg.Columns("A").ColumnWidth = 35
trg.Columns("A").WrapText = True
trg.Columns("B").ColumnWidth = 50
trg.Columns("B").WrapText = True
trg.Columns("C").ColumnWidth = 15
trg.Columns("D").ColumnWidth = 15
trg.Columns("E").ColumnWidth = 15
'Screen updating should be activated
Application.ScreenUpdating = True
End Sub
Anywho, I found a couple of pieces of code on this site that got me VERY close to what I want to accomplish (thanks to you all), but I'm having trouble massaging it to do what I want.:whip
I have a set of project worksheets which are all formatted the same way (if I can keep my boss from changing them): same headers, same number of columns, all headers are in row 3 of worksheet, etc.
Here are the things I want to do:
For each worksheet:
insert the worksheet name into the next available empty row in the Summary Report worksheet
add headers for each worksheet extract
copy rows to the Summary Report worksheet only if the date in the Deadline column falls w/in a date range.
skip a row in the Summary Report worksheet between each data setI've added comments in the code where I think the actions should take place. I've also attached the file I'm trying to automate. (OK, so the worksheets aren't all the same right now and they all don't have data, but I'm working with what I have now and will sync things before I finalize the project.)
Can someone help me put all the pieces together?
I'd be ever SOOOO GRATEFUL!!!!!
Here's the code I'm using:
Sub CreateSummaryReport()
Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim trg As Worksheet 'Summary Report Worksheet
Dim rng As Range 'Range object
Dim colCount As Integer 'Column count in tables in the worksheets
Set wrk = ActiveWorkbook 'Working in active workbook
'Checks for an existing Summary report and displays a msg if there is
For Each sht In wrk.Worksheets
If sht.Name = "Summary Report" Then
MsgBox "There is a worksheet called as 'Summary Report'." & vbCrLf & _
"Please remove or rename this worksheet since 'Summary Report' would be" & _
"the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
Exit Sub
End If
Next sht
'We don't want screen updating
Application.ScreenUpdating = False
'Add new worksheet as the last worksheet
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
'Rename the new worksheet
trg.Name = "Summary Report"
'Point to first worksheet in workbook
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(1, 255).End(xlToLeft).Column
'Start loop
For Each sht In wrk.Worksheets
'If worksheet in loop is the last one, stop execution (it is Summary Report worksheet)
If sht.Index = wrk.Worksheets.Count Then
Exit For
End If
'Skip a row in Summary Report worksheet
'Put sheet name in next available cell in column A of Summary Report
'Retrieve column headers and put them in Summary Report (always in row 3 of worksheet)
'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
'copy only those rows that match preset date range
'If value in column E >= Date And value in column E <= Date + 7 Then
'copy the row
'Put data into the Master worksheet
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Next sht
'Resize the columns in Summary Report worksheet
trg.Columns("A").ColumnWidth = 35
trg.Columns("A").WrapText = True
trg.Columns("B").ColumnWidth = 50
trg.Columns("B").WrapText = True
trg.Columns("C").ColumnWidth = 15
trg.Columns("D").ColumnWidth = 15
trg.Columns("E").ColumnWidth = 15
'Screen updating should be activated
Application.ScreenUpdating = True
End Sub