Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert Worksheets based on column data.
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 Malcolm Davzidson |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert Worksheets based on column data.
Hi,
Not extensively tested but try this Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1")' Change to suit 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") sht.Activate Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: 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 Malcolm Davzidson |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert Worksheets based on column data.
Mike
First impressions look amazing. Done a couple of random checks and so far all the data is correct. Now, not meaning to be greedy as what you have done so far is fantastic, but is there a way of adding something that will auto sum colum B and auto sum column C and also make columns B & C so they format as number to two decimal points. I appreciate if that's a question to far but you appear to be a Ninja with Excel. Once again, thanks for what you have done. Regards Malcolm Davidson "Mike H" wrote: Hi, Not extensively tested but try this Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1")' Change to suit 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") sht.Activate Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: 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 Malcolm Davzidson |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert Worksheets based on column data.
Is your staff data in Col. G sorted? I believe Mikes code works beautifully
if it is sorted. I basically tweaked Mikes code. Hope this helps! If so, let me know, click "YES" below. Sub stantial() Dim MyRange As Range Dim CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1") ' Change to suit 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") sht.Activate Set CopyRange = Nothing ' add sum formula at end of Col.B & Col. C With wks lastrow = .Cells(Rows.Count, "G").End(xlUp).Row .Cells(lastrow + 1, "B").Formula = "=SUM(B2:B" & lastrow & ")" .Cells(lastrow + 1, "C").Formula = "=SUM(C2:C" & lastrow & ")" ' number format .Range("B2:B" & lastrow + 1).NumberFormat = "0.00" .Range("C2:C" & lastrow + 1).NumberFormat = "0.00" End With End If Next c End Sub -- Cheers, Ryan "malycom" wrote: Mike First impressions look amazing. Done a couple of random checks and so far all the data is correct. Now, not meaning to be greedy as what you have done so far is fantastic, but is there a way of adding something that will auto sum colum B and auto sum column C and also make columns B & C so they format as number to two decimal points. I appreciate if that's a question to far but you appear to be a Ninja with Excel. Once again, thanks for what you have done. Regards Malcolm Davidson "Mike H" wrote: Hi, Not extensively tested but try this Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1")' Change to suit 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") sht.Activate Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: 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 Malcolm Davzidson |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert Worksheets based on column data.
Hi,
This should take care of the summing and number formatting but because I have included NO error checking you will get an error if you try and run the code again because the shhet being added will already exist so you must delete these sheets before re-running the code 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 -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: Mike First impressions look amazing. Done a couple of random checks and so far all the data is correct. Now, not meaning to be greedy as what you have done so far is fantastic, but is there a way of adding something that will auto sum colum B and auto sum column C and also make columns B & C so they format as number to two decimal points. I appreciate if that's a question to far but you appear to be a Ninja with Excel. Once again, thanks for what you have done. Regards Malcolm Davidson "Mike H" wrote: Hi, Not extensively tested but try this Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1")' Change to suit 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") sht.Activate Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: 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 Malcolm Davzidson |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert Worksheets based on column data.
from the OP's original question
The last column (G) uses a staff code and is sorted in ascending order. -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "Ryan H" wrote: Is your staff data in Col. G sorted? I believe Mikes code works beautifully if it is sorted. I basically tweaked Mikes code. Hope this helps! If so, let me know, click "YES" below. Sub stantial() Dim MyRange As Range Dim CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1") ' Change to suit 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") sht.Activate Set CopyRange = Nothing ' add sum formula at end of Col.B & Col. C With wks lastrow = .Cells(Rows.Count, "G").End(xlUp).Row .Cells(lastrow + 1, "B").Formula = "=SUM(B2:B" & lastrow & ")" .Cells(lastrow + 1, "C").Formula = "=SUM(C2:C" & lastrow & ")" ' number format .Range("B2:B" & lastrow + 1).NumberFormat = "0.00" .Range("C2:C" & lastrow + 1).NumberFormat = "0.00" End With End If Next c End Sub -- Cheers, Ryan "malycom" wrote: Mike First impressions look amazing. Done a couple of random checks and so far all the data is correct. Now, not meaning to be greedy as what you have done so far is fantastic, but is there a way of adding something that will auto sum colum B and auto sum column C and also make columns B & C so they format as number to two decimal points. I appreciate if that's a question to far but you appear to be a Ninja with Excel. Once again, thanks for what you have done. Regards Malcolm Davidson "Mike H" wrote: Hi, Not extensively tested but try this Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1")' Change to suit 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") sht.Activate Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: 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 Malcolm Davzidson |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert Worksheets based on column data.
My mistake Mike. Thanks for the correction!
-- Cheers, Ryan "Mike H" wrote: from the OP's original question The last column (G) uses a staff code and is sorted in ascending order. -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "Ryan H" wrote: Is your staff data in Col. G sorted? I believe Mikes code works beautifully if it is sorted. I basically tweaked Mikes code. Hope this helps! If so, let me know, click "YES" below. Sub stantial() Dim MyRange As Range Dim CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1") ' Change to suit 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") sht.Activate Set CopyRange = Nothing ' add sum formula at end of Col.B & Col. C With wks lastrow = .Cells(Rows.Count, "G").End(xlUp).Row .Cells(lastrow + 1, "B").Formula = "=SUM(B2:B" & lastrow & ")" .Cells(lastrow + 1, "C").Formula = "=SUM(C2:C" & lastrow & ")" ' number format .Range("B2:B" & lastrow + 1).NumberFormat = "0.00" .Range("C2:C" & lastrow + 1).NumberFormat = "0.00" End With End If Next c End Sub -- Cheers, Ryan "malycom" wrote: Mike First impressions look amazing. Done a couple of random checks and so far all the data is correct. Now, not meaning to be greedy as what you have done so far is fantastic, but is there a way of adding something that will auto sum colum B and auto sum column C and also make columns B & C so they format as number to two decimal points. I appreciate if that's a question to far but you appear to be a Ninja with Excel. Once again, thanks for what you have done. Regards Malcolm Davidson "Mike H" wrote: Hi, Not extensively tested but try this Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1")' Change to suit 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") sht.Activate Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: 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 Malcolm Davzidson |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert Worksheets based on column data.
Mike & Ryan
Thank you both so much for your help. I actually appear to be a genius at work, although as usual, that will be short lived. The worksheet does and shows exactly what it is supposed to. Once again, thank you bnoth very much. Regards Malcolm Davidson "Mike H" wrote: Hi, This should take care of the summing and number formatting but because I have included NO error checking you will get an error if you try and run the code again because the shhet being added will already exist so you must delete these sheets before re-running the code 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 -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: Mike First impressions look amazing. Done a couple of random checks and so far all the data is correct. Now, not meaning to be greedy as what you have done so far is fantastic, but is there a way of adding something that will auto sum colum B and auto sum column C and also make columns B & C so they format as number to two decimal points. I appreciate if that's a question to far but you appear to be a Ninja with Excel. Once again, thanks for what you have done. Regards Malcolm Davidson "Mike H" wrote: Hi, Not extensively tested but try this Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1")' Change to suit 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") sht.Activate Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: 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 Malcolm Davzidson |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert Worksheets based on column data.
Glad I could help and don't tell your work colleagues you never wrote the
code :) -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: Mike & Ryan Thank you both so much for your help. I actually appear to be a genius at work, although as usual, that will be short lived. The worksheet does and shows exactly what it is supposed to. Once again, thank you bnoth very much. Regards Malcolm Davidson "Mike H" wrote: Hi, This should take care of the summing and number formatting but because I have included NO error checking you will get an error if you try and run the code again because the shhet being added will already exist so you must delete these sheets before re-running the code 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 -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: Mike First impressions look amazing. Done a couple of random checks and so far all the data is correct. Now, not meaning to be greedy as what you have done so far is fantastic, but is there a way of adding something that will auto sum colum B and auto sum column C and also make columns B & C so they format as number to two decimal points. I appreciate if that's a question to far but you appear to be a Ninja with Excel. Once again, thanks for what you have done. Regards Malcolm Davidson "Mike H" wrote: Hi, Not extensively tested but try this Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1")' Change to suit 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") sht.Activate Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: 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 Malcolm Davzidson |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert Worksheets based on column data.
I'm to honest for that Mike. I always tell them where I get my help,
otherwise they think I'm just browsing the internet :-) Cheers "Mike H" wrote: Glad I could help and don't tell your work colleagues you never wrote the code :) -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: Mike & Ryan Thank you both so much for your help. I actually appear to be a genius at work, although as usual, that will be short lived. The worksheet does and shows exactly what it is supposed to. Once again, thank you bnoth very much. Regards Malcolm Davidson "Mike H" wrote: Hi, This should take care of the summing and number formatting but because I have included NO error checking you will get an error if you try and run the code again because the shhet being added will already exist so you must delete these sheets before re-running the code 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 -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: Mike First impressions look amazing. Done a couple of random checks and so far all the data is correct. Now, not meaning to be greedy as what you have done so far is fantastic, but is there a way of adding something that will auto sum colum B and auto sum column C and also make columns B & C so they format as number to two decimal points. I appreciate if that's a question to far but you appear to be a Ninja with Excel. Once again, thanks for what you have done. Regards Malcolm Davidson "Mike H" wrote: Hi, Not extensively tested but try this Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1")' Change to suit 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") sht.Activate Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: 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 Malcolm Davzidson |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert Worksheets based on column data.
Hi Mike
I have just gone to run this for the first time as a needed report and I have encountered an error. It appears if there is only one record for a particular member of staff, ie, Column G, the macro throws an error message and something about 'Object Variable or With block variable not set' When I click debug, the highlighted lines are the two lines that start with CopyRange.Resize (CopyRange.Rows.Count + 1).Copy _ Destination:=Sheets(c.Value).Range("A1") There is an arrow pointing to the second line which is the Destination:=Sheets line. Any way you can help with this problem? Many thanks Malcolm Davidson "Mike H" wrote: Hi, This should take care of the summing and number formatting but because I have included NO error checking you will get an error if you try and run the code again because the shhet being added will already exist so you must delete these sheets before re-running the code 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 -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: Mike First impressions look amazing. Done a couple of random checks and so far all the data is correct. Now, not meaning to be greedy as what you have done so far is fantastic, but is there a way of adding something that will auto sum colum B and auto sum column C and also make columns B & C so they format as number to two decimal points. I appreciate if that's a question to far but you appear to be a Ninja with Excel. Once again, thanks for what you have done. Regards Malcolm Davidson "Mike H" wrote: Hi, Not extensively tested but try this Sub stantial() Dim MyRange As Range, CopyRange As Range Dim lastrow As Long Set sht = Sheets("Sheet1")' Change to suit 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") sht.Activate Set CopyRange = Nothing End If Next End Sub -- Mike When competing hypotheses are otherwise equal, adopt the hypothesis that introduces the fewest assumptions while still sufficiently answering the question. "malycom" wrote: 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 Malcolm Davzidson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Insert Column based on data in Row. | Excel Programming | |||
Create Worksheets based on column data | Excel Programming | |||
Insert Blank Row Based on Value in Column A | Excel Programming | |||
copy and insert entire row based on integer in column A | Excel Programming | |||
Insert duplicate rows based on numeric value in column | Excel Discussion (Misc queries) |