Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with this macro script on single results.
Hi
I put a request out a few days ago and I am attaching the macro script as well so you can see where I am up to. The problem is, if there is only one result returned for a particular staff member, the script falls with a variable object error. If there is more than 1 record, the script works fine. It just falls where a single record is returned. I am attaching the original message I sent as well as the script. PLease note that Mike, the guy that helped me immensley witht his, has also doen a few other things like auto summing which you will see in the script but not in my original message. Original message and help ================================================ Hi everyone I run a report that creates a 7 coumn spreadsheet analysing staff time through a week. The last column (G) uses a staff code and is sorted in ascending order. What I would like to do is to run a macro or program that will go through the spreadsheet and create a new worksheet for each Staff code, naming the worksheet exactly the same, and inserting all the rows of data belonging to each staff code into its individual worksheet. For instance, if one of the Staff codes in the original pages is TW and there are 9 rows of data for TW, I would like a worksheet inserted called TW and then all those 9 rows of data copied into it from say Row B. In the main sheet there are a load of heading in row A which ideally could also be copied into Row A of each worksheet. As much detail as possible would be really appreciated here as I don't have a clue how to go about it. Thanks in advance Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1") lastrow = sht.Cells(Cells.Rows.Count, "G").End(xlUp).Row Set MyRange = sht.Range("G1:G" & lastrow) For Each c In MyRange If c.Value = c.Offset(1).Value Then If CopyRange Is Nothing Then Set CopyRange = c.EntireRow Else Set CopyRange = Union(CopyRange, c.EntireRow) End If Else Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = c.Value CopyRange.Resize(CopyRange.Rows.Count + 1).Copy _ Destination:=Sheets(c.Value).Range("A1") thislastrow = Sheets(c.Value).Cells(Cells.Rows.Count, "G").End(xlUp).Row + 1 Range("B" & thislastrow).Formula = "=sum(B1:B" & thislastrow - 1 & ")" Range("C" & thislastrow).Formula = "=sum(C1:C" & thislastrow - 1 & ")" Sheets(c.Value).Columns("B:C").NumberFormat = "0.00" sht.Activate Set CopyRange = Nothing End If Next End Sub ================================================== Any help with this is greatly appreciated. Thanks in advance Malcolm |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with this macro script on single results.
Hi,
Change: Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = c.Value to this: Set CopyRange = Union(CopyRange, c.EntireRow) Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = c.Value What you currently have checks if the value in the cell is the same as the one below it. If it is it adds it to copy range, if it's not then it pastes copyrange into the new sheet - but copy range will be nothing as you haven't set it. Sam "malycom" wrote: Hi I put a request out a few days ago and I am attaching the macro script as well so you can see where I am up to. The problem is, if there is only one result returned for a particular staff member, the script falls with a variable object error. If there is more than 1 record, the script works fine. It just falls where a single record is returned. I am attaching the original message I sent as well as the script. PLease note that Mike, the guy that helped me immensley witht his, has also doen a few other things like auto summing which you will see in the script but not in my original message. Original message and help ================================================ Hi everyone I run a report that creates a 7 coumn spreadsheet analysing staff time through a week. The last column (G) uses a staff code and is sorted in ascending order. What I would like to do is to run a macro or program that will go through the spreadsheet and create a new worksheet for each Staff code, naming the worksheet exactly the same, and inserting all the rows of data belonging to each staff code into its individual worksheet. For instance, if one of the Staff codes in the original pages is TW and there are 9 rows of data for TW, I would like a worksheet inserted called TW and then all those 9 rows of data copied into it from say Row B. In the main sheet there are a load of heading in row A which ideally could also be copied into Row A of each worksheet. As much detail as possible would be really appreciated here as I don't have a clue how to go about it. Thanks in advance Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1") lastrow = sht.Cells(Cells.Rows.Count, "G").End(xlUp).Row Set MyRange = sht.Range("G1:G" & lastrow) For Each c In MyRange If c.Value = c.Offset(1).Value Then If CopyRange Is Nothing Then Set CopyRange = c.EntireRow Else Set CopyRange = Union(CopyRange, c.EntireRow) End If Else Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = c.Value CopyRange.Resize(CopyRange.Rows.Count + 1).Copy _ Destination:=Sheets(c.Value).Range("A1") thislastrow = Sheets(c.Value).Cells(Cells.Rows.Count, "G").End(xlUp).Row + 1 Range("B" & thislastrow).Formula = "=sum(B1:B" & thislastrow - 1 & ")" Range("C" & thislastrow).Formula = "=sum(C1:C" & thislastrow - 1 & ")" Sheets(c.Value).Columns("B:C").NumberFormat = "0.00" sht.Activate Set CopyRange = Nothing End If Next End Sub ================================================== Any help with this is greatly appreciated. Thanks in advance Malcolm |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with this macro script on single results.
Hi Sam
Thanks for your help but this now causes a different error. What happens is the works sheets are created for the individual staff members as it should, but the last row of each worksheet contains the first record for the next staff member that should be in a new worksheet. Also, when it hits a single record again, that record does appear as the last record in the previous members worksheet but then the system stops again with an error message. In debug mode, the fist line that I changed to match your advice is yellow and if I hover my mouse over the Union(CopyRange, c.EntireRow), a hint message of CopyRange = Nothing is shown. Not sure if that's supposed to be what it says or not. Any other ideas? Thanks for your help though. Malcolm "Sam Wilson" wrote: Hi, Change: Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = c.Value to this: Set CopyRange = Union(CopyRange, c.EntireRow) Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = c.Value What you currently have checks if the value in the cell is the same as the one below it. If it is it adds it to copy range, if it's not then it pastes copyrange into the new sheet - but copy range will be nothing as you haven't set it. Sam "malycom" wrote: Hi I put a request out a few days ago and I am attaching the macro script as well so you can see where I am up to. The problem is, if there is only one result returned for a particular staff member, the script falls with a variable object error. If there is more than 1 record, the script works fine. It just falls where a single record is returned. I am attaching the original message I sent as well as the script. PLease note that Mike, the guy that helped me immensley witht his, has also doen a few other things like auto summing which you will see in the script but not in my original message. Original message and help ================================================ Hi everyone I run a report that creates a 7 coumn spreadsheet analysing staff time through a week. The last column (G) uses a staff code and is sorted in ascending order. What I would like to do is to run a macro or program that will go through the spreadsheet and create a new worksheet for each Staff code, naming the worksheet exactly the same, and inserting all the rows of data belonging to each staff code into its individual worksheet. For instance, if one of the Staff codes in the original pages is TW and there are 9 rows of data for TW, I would like a worksheet inserted called TW and then all those 9 rows of data copied into it from say Row B. In the main sheet there are a load of heading in row A which ideally could also be copied into Row A of each worksheet. As much detail as possible would be really appreciated here as I don't have a clue how to go about it. Thanks in advance Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1") lastrow = sht.Cells(Cells.Rows.Count, "G").End(xlUp).Row Set MyRange = sht.Range("G1:G" & lastrow) For Each c In MyRange If c.Value = c.Offset(1).Value Then If CopyRange Is Nothing Then Set CopyRange = c.EntireRow Else Set CopyRange = Union(CopyRange, c.EntireRow) End If Else Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = c.Value CopyRange.Resize(CopyRange.Rows.Count + 1).Copy _ Destination:=Sheets(c.Value).Range("A1") thislastrow = Sheets(c.Value).Cells(Cells.Rows.Count, "G").End(xlUp).Row + 1 Range("B" & thislastrow).Formula = "=sum(B1:B" & thislastrow - 1 & ")" Range("C" & thislastrow).Formula = "=sum(C1:C" & thislastrow - 1 & ")" Sheets(c.Value).Columns("B:C").NumberFormat = "0.00" sht.Activate Set CopyRange = Nothing End If Next End Sub ================================================== Any help with this is greatly appreciated. Thanks in advance Malcolm |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with this macro script on single results.
Try the below
Sub stantial() Dim ws As Worksheet, wsTemp As Worksheet Dim lngRow As Long, lngStartRow As Long, lngTargetRow As Long Set ws = Sheets("Sheet1") lngStartRow = 2 For lngRow = lngStartRow + 1 To ws.Cells(Rows.Count, "G").End(xlUp).Row + 1 If ws.Range("G" & lngRow) < ws.Range("G" & lngRow - 1) Then On Error Resume Next Set wsTemp = Sheets(CStr(ws.Range("G" & lngRow - 1))) On Error GoTo 0 If wsTemp Is Nothing Then Set wsTemp = Worksheets.Add(After:=ws) wsTemp.Name = ws.Range("G" & lngRow - 1) ws.Rows(1).Copy wsTemp.Range("A1") End If lngTargetRow = wsTemp.Cells(Rows.Count, "G").End(xlUp).Row ws.Range("A" & lngStartRow & ":G" & lngRow - 1).Copy _ wsTemp.Range("A" & lngTargetRow + 1) Set wsTemp = Nothing lngStartRow = lngRow End If Next End Sub -- Jacob "malycom" wrote: Hi I put a request out a few days ago and I am attaching the macro script as well so you can see where I am up to. The problem is, if there is only one result returned for a particular staff member, the script falls with a variable object error. If there is more than 1 record, the script works fine. It just falls where a single record is returned. I am attaching the original message I sent as well as the script. PLease note that Mike, the guy that helped me immensley witht his, has also doen a few other things like auto summing which you will see in the script but not in my original message. Original message and help ================================================ Hi everyone I run a report that creates a 7 coumn spreadsheet analysing staff time through a week. The last column (G) uses a staff code and is sorted in ascending order. What I would like to do is to run a macro or program that will go through the spreadsheet and create a new worksheet for each Staff code, naming the worksheet exactly the same, and inserting all the rows of data belonging to each staff code into its individual worksheet. For instance, if one of the Staff codes in the original pages is TW and there are 9 rows of data for TW, I would like a worksheet inserted called TW and then all those 9 rows of data copied into it from say Row B. In the main sheet there are a load of heading in row A which ideally could also be copied into Row A of each worksheet. As much detail as possible would be really appreciated here as I don't have a clue how to go about it. Thanks in advance Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1") lastrow = sht.Cells(Cells.Rows.Count, "G").End(xlUp).Row Set MyRange = sht.Range("G1:G" & lastrow) For Each c In MyRange If c.Value = c.Offset(1).Value Then If CopyRange Is Nothing Then Set CopyRange = c.EntireRow Else Set CopyRange = Union(CopyRange, c.EntireRow) End If Else Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = c.Value CopyRange.Resize(CopyRange.Rows.Count + 1).Copy _ Destination:=Sheets(c.Value).Range("A1") thislastrow = Sheets(c.Value).Cells(Cells.Rows.Count, "G").End(xlUp).Row + 1 Range("B" & thislastrow).Formula = "=sum(B1:B" & thislastrow - 1 & ")" Range("C" & thislastrow).Formula = "=sum(C1:C" & thislastrow - 1 & ")" Sheets(c.Value).Columns("B:C").NumberFormat = "0.00" sht.Activate Set CopyRange = Nothing End If Next End Sub ================================================== Any help with this is greatly appreciated. Thanks in advance Malcolm |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with this macro script on single results.
Hi Jacob
Very close but now the auto sum of columns B & C has dissapeared from each of the worksheets. Admitedly, it wasn't in my initial request but it is something that I asked another person to add. Is there any way to get this auto summing back in please? Thanks for your help - I don't know how you guys do it. Malcolm "Jacob Skaria" wrote: Try the below Sub stantial() Dim ws As Worksheet, wsTemp As Worksheet Dim lngRow As Long, lngStartRow As Long, lngTargetRow As Long Set ws = Sheets("Sheet1") lngStartRow = 2 For lngRow = lngStartRow + 1 To ws.Cells(Rows.Count, "G").End(xlUp).Row + 1 If ws.Range("G" & lngRow) < ws.Range("G" & lngRow - 1) Then On Error Resume Next Set wsTemp = Sheets(CStr(ws.Range("G" & lngRow - 1))) On Error GoTo 0 If wsTemp Is Nothing Then Set wsTemp = Worksheets.Add(After:=ws) wsTemp.Name = ws.Range("G" & lngRow - 1) ws.Rows(1).Copy wsTemp.Range("A1") End If lngTargetRow = wsTemp.Cells(Rows.Count, "G").End(xlUp).Row ws.Range("A" & lngStartRow & ":G" & lngRow - 1).Copy _ wsTemp.Range("A" & lngTargetRow + 1) Set wsTemp = Nothing lngStartRow = lngRow End If Next End Sub -- Jacob "malycom" wrote: Hi I put a request out a few days ago and I am attaching the macro script as well so you can see where I am up to. The problem is, if there is only one result returned for a particular staff member, the script falls with a variable object error. If there is more than 1 record, the script works fine. It just falls where a single record is returned. I am attaching the original message I sent as well as the script. PLease note that Mike, the guy that helped me immensley witht his, has also doen a few other things like auto summing which you will see in the script but not in my original message. Original message and help ================================================ Hi everyone I run a report that creates a 7 coumn spreadsheet analysing staff time through a week. The last column (G) uses a staff code and is sorted in ascending order. What I would like to do is to run a macro or program that will go through the spreadsheet and create a new worksheet for each Staff code, naming the worksheet exactly the same, and inserting all the rows of data belonging to each staff code into its individual worksheet. For instance, if one of the Staff codes in the original pages is TW and there are 9 rows of data for TW, I would like a worksheet inserted called TW and then all those 9 rows of data copied into it from say Row B. In the main sheet there are a load of heading in row A which ideally could also be copied into Row A of each worksheet. As much detail as possible would be really appreciated here as I don't have a clue how to go about it. Thanks in advance Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1") lastrow = sht.Cells(Cells.Rows.Count, "G").End(xlUp).Row Set MyRange = sht.Range("G1:G" & lastrow) For Each c In MyRange If c.Value = c.Offset(1).Value Then If CopyRange Is Nothing Then Set CopyRange = c.EntireRow Else Set CopyRange = Union(CopyRange, c.EntireRow) End If Else Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = c.Value CopyRange.Resize(CopyRange.Rows.Count + 1).Copy _ Destination:=Sheets(c.Value).Range("A1") thislastrow = Sheets(c.Value).Cells(Cells.Rows.Count, "G").End(xlUp).Row + 1 Range("B" & thislastrow).Formula = "=sum(B1:B" & thislastrow - 1 & ")" Range("C" & thislastrow).Formula = "=sum(C1:C" & thislastrow - 1 & ")" Sheets(c.Value).Columns("B:C").NumberFormat = "0.00" sht.Activate Set CopyRange = Nothing End If Next End Sub ================================================== Any help with this is greatly appreciated. Thanks in advance Malcolm |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with this macro script on single results.
I missed that..
Sub stantial() Dim ws As Worksheet, wsTemp As Worksheet Dim lngRow As Long, lngStartRow As Long, lngTargetRow As Long Set ws = Sheets("Sheet1") lngStartRow = 2 For lngRow = lngStartRow + 1 To ws.Cells(Rows.Count, "G").End(xlUp).Row + 1 If ws.Range("G" & lngRow) < ws.Range("G" & lngRow - 1) Then On Error Resume Next Set wsTemp = Sheets(CStr(ws.Range("G" & lngRow - 1))) On Error GoTo 0 If wsTemp Is Nothing Then Set wsTemp = Worksheets.Add(After:=ws) wsTemp.Name = ws.Range("G" & lngRow - 1) ws.Rows(1).Copy wsTemp.Range("A1") End If lngTargetRow = wsTemp.Cells(Rows.Count, "G").End(xlUp).Row ws.Range("A" & lngStartRow & ":G" & lngRow - 1).Copy _ wsTemp.Range("A" & lngTargetRow + 1) lngTargetRow = wsTemp.Cells(Rows.Count, "G").End(xlUp).Row wsTemp.Range("B" & lngTargetRow + 1).Formula = _ "=SUM(B1:B" & lngTargetRow & ")" wsTemp.Range("C" & lngTargetRow + 1).Formula = _ "=SUM(C1:C" & lngTargetRow & ")" Set wsTemp = Nothing lngStartRow = lngRow End If Next End Sub -- Jacob "malycom" wrote: Hi Jacob Very close but now the auto sum of columns B & C has dissapeared from each of the worksheets. Admitedly, it wasn't in my initial request but it is something that I asked another person to add. Is there any way to get this auto summing back in please? Thanks for your help - I don't know how you guys do it. Malcolm "Jacob Skaria" wrote: Try the below Sub stantial() Dim ws As Worksheet, wsTemp As Worksheet Dim lngRow As Long, lngStartRow As Long, lngTargetRow As Long Set ws = Sheets("Sheet1") lngStartRow = 2 For lngRow = lngStartRow + 1 To ws.Cells(Rows.Count, "G").End(xlUp).Row + 1 If ws.Range("G" & lngRow) < ws.Range("G" & lngRow - 1) Then On Error Resume Next Set wsTemp = Sheets(CStr(ws.Range("G" & lngRow - 1))) On Error GoTo 0 If wsTemp Is Nothing Then Set wsTemp = Worksheets.Add(After:=ws) wsTemp.Name = ws.Range("G" & lngRow - 1) ws.Rows(1).Copy wsTemp.Range("A1") End If lngTargetRow = wsTemp.Cells(Rows.Count, "G").End(xlUp).Row ws.Range("A" & lngStartRow & ":G" & lngRow - 1).Copy _ wsTemp.Range("A" & lngTargetRow + 1) Set wsTemp = Nothing lngStartRow = lngRow End If Next End Sub -- Jacob "malycom" wrote: Hi I put a request out a few days ago and I am attaching the macro script as well so you can see where I am up to. The problem is, if there is only one result returned for a particular staff member, the script falls with a variable object error. If there is more than 1 record, the script works fine. It just falls where a single record is returned. I am attaching the original message I sent as well as the script. PLease note that Mike, the guy that helped me immensley witht his, has also doen a few other things like auto summing which you will see in the script but not in my original message. Original message and help ================================================ Hi everyone I run a report that creates a 7 coumn spreadsheet analysing staff time through a week. The last column (G) uses a staff code and is sorted in ascending order. What I would like to do is to run a macro or program that will go through the spreadsheet and create a new worksheet for each Staff code, naming the worksheet exactly the same, and inserting all the rows of data belonging to each staff code into its individual worksheet. For instance, if one of the Staff codes in the original pages is TW and there are 9 rows of data for TW, I would like a worksheet inserted called TW and then all those 9 rows of data copied into it from say Row B. In the main sheet there are a load of heading in row A which ideally could also be copied into Row A of each worksheet. As much detail as possible would be really appreciated here as I don't have a clue how to go about it. Thanks in advance Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1") lastrow = sht.Cells(Cells.Rows.Count, "G").End(xlUp).Row Set MyRange = sht.Range("G1:G" & lastrow) For Each c In MyRange If c.Value = c.Offset(1).Value Then If CopyRange Is Nothing Then Set CopyRange = c.EntireRow Else Set CopyRange = Union(CopyRange, c.EntireRow) End If Else Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = c.Value CopyRange.Resize(CopyRange.Rows.Count + 1).Copy _ Destination:=Sheets(c.Value).Range("A1") thislastrow = Sheets(c.Value).Cells(Cells.Rows.Count, "G").End(xlUp).Row + 1 Range("B" & thislastrow).Formula = "=sum(B1:B" & thislastrow - 1 & ")" Range("C" & thislastrow).Formula = "=sum(C1:C" & thislastrow - 1 & ")" Sheets(c.Value).Columns("B:C").NumberFormat = "0.00" sht.Activate Set CopyRange = Nothing End If Next End Sub ================================================== Any help with this is greatly appreciated. Thanks in advance Malcolm |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with this macro script on single results.
Thank you so much
Everything working fine now. Appreciate the help from everybody. Malcolm "Jacob Skaria" wrote: I missed that.. Sub stantial() Dim ws As Worksheet, wsTemp As Worksheet Dim lngRow As Long, lngStartRow As Long, lngTargetRow As Long Set ws = Sheets("Sheet1") lngStartRow = 2 For lngRow = lngStartRow + 1 To ws.Cells(Rows.Count, "G").End(xlUp).Row + 1 If ws.Range("G" & lngRow) < ws.Range("G" & lngRow - 1) Then On Error Resume Next Set wsTemp = Sheets(CStr(ws.Range("G" & lngRow - 1))) On Error GoTo 0 If wsTemp Is Nothing Then Set wsTemp = Worksheets.Add(After:=ws) wsTemp.Name = ws.Range("G" & lngRow - 1) ws.Rows(1).Copy wsTemp.Range("A1") End If lngTargetRow = wsTemp.Cells(Rows.Count, "G").End(xlUp).Row ws.Range("A" & lngStartRow & ":G" & lngRow - 1).Copy _ wsTemp.Range("A" & lngTargetRow + 1) lngTargetRow = wsTemp.Cells(Rows.Count, "G").End(xlUp).Row wsTemp.Range("B" & lngTargetRow + 1).Formula = _ "=SUM(B1:B" & lngTargetRow & ")" wsTemp.Range("C" & lngTargetRow + 1).Formula = _ "=SUM(C1:C" & lngTargetRow & ")" Set wsTemp = Nothing lngStartRow = lngRow End If Next End Sub -- Jacob "malycom" wrote: Hi Jacob Very close but now the auto sum of columns B & C has dissapeared from each of the worksheets. Admitedly, it wasn't in my initial request but it is something that I asked another person to add. Is there any way to get this auto summing back in please? Thanks for your help - I don't know how you guys do it. Malcolm "Jacob Skaria" wrote: Try the below Sub stantial() Dim ws As Worksheet, wsTemp As Worksheet Dim lngRow As Long, lngStartRow As Long, lngTargetRow As Long Set ws = Sheets("Sheet1") lngStartRow = 2 For lngRow = lngStartRow + 1 To ws.Cells(Rows.Count, "G").End(xlUp).Row + 1 If ws.Range("G" & lngRow) < ws.Range("G" & lngRow - 1) Then On Error Resume Next Set wsTemp = Sheets(CStr(ws.Range("G" & lngRow - 1))) On Error GoTo 0 If wsTemp Is Nothing Then Set wsTemp = Worksheets.Add(After:=ws) wsTemp.Name = ws.Range("G" & lngRow - 1) ws.Rows(1).Copy wsTemp.Range("A1") End If lngTargetRow = wsTemp.Cells(Rows.Count, "G").End(xlUp).Row ws.Range("A" & lngStartRow & ":G" & lngRow - 1).Copy _ wsTemp.Range("A" & lngTargetRow + 1) Set wsTemp = Nothing lngStartRow = lngRow End If Next End Sub -- Jacob "malycom" wrote: Hi I put a request out a few days ago and I am attaching the macro script as well so you can see where I am up to. The problem is, if there is only one result returned for a particular staff member, the script falls with a variable object error. If there is more than 1 record, the script works fine. It just falls where a single record is returned. I am attaching the original message I sent as well as the script. PLease note that Mike, the guy that helped me immensley witht his, has also doen a few other things like auto summing which you will see in the script but not in my original message. Original message and help ================================================ Hi everyone I run a report that creates a 7 coumn spreadsheet analysing staff time through a week. The last column (G) uses a staff code and is sorted in ascending order. What I would like to do is to run a macro or program that will go through the spreadsheet and create a new worksheet for each Staff code, naming the worksheet exactly the same, and inserting all the rows of data belonging to each staff code into its individual worksheet. For instance, if one of the Staff codes in the original pages is TW and there are 9 rows of data for TW, I would like a worksheet inserted called TW and then all those 9 rows of data copied into it from say Row B. In the main sheet there are a load of heading in row A which ideally could also be copied into Row A of each worksheet. As much detail as possible would be really appreciated here as I don't have a clue how to go about it. Thanks in advance Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1") lastrow = sht.Cells(Cells.Rows.Count, "G").End(xlUp).Row Set MyRange = sht.Range("G1:G" & lastrow) For Each c In MyRange If c.Value = c.Offset(1).Value Then If CopyRange Is Nothing Then Set CopyRange = c.EntireRow Else Set CopyRange = Union(CopyRange, c.EntireRow) End If Else Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = c.Value CopyRange.Resize(CopyRange.Rows.Count + 1).Copy _ Destination:=Sheets(c.Value).Range("A1") thislastrow = Sheets(c.Value).Cells(Cells.Rows.Count, "G").End(xlUp).Row + 1 Range("B" & thislastrow).Formula = "=sum(B1:B" & thislastrow - 1 & ")" Range("C" & thislastrow).Formula = "=sum(C1:C" & thislastrow - 1 & ")" Sheets(c.Value).Columns("B:C").NumberFormat = "0.00" sht.Activate Set CopyRange = Nothing End If Next End Sub ================================================== Any help with this is greatly appreciated. Thanks in advance Malcolm |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
single lookup value with multiple results | Excel Worksheet Functions | |||
Returning Numeric Results across a Single Row in Consecutive Cells | Excel Worksheet Functions | |||
several scripts in one single script | Excel Programming | |||
Displaying the results of multiple formulas in a single cell. | New Users to Excel |