Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Create new sheets from data in either of two columns
I am a novice excel user but need help with a macro. I have a
spreadsheet with 21 columns A to U on sheet 1. I would like if information is entered into column C or column F the row, Column A to U would be copied to new sheet with name of the data found in either column C or F. If the name sheet already rewrite to the named sheet. The header row is A2 to U2 Data is in A3:U382 There will be a maximum of twenty different text values in the C and F columns. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Create new sheets from data in either of two columns
Right-click the main sheet tab. Select View Code. Paste the following code
there. Test to see if you get the results you expect. You may want to use a duplicate copy of your workbook so as not to imperil real data. Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim wks As Worksheet Dim wksThisSheet As Worksheet Set wksThisSheet = ActiveSheet Application.ScreenUpdating = False If Not Intersect(Target, Range("C3:C382")) Is Nothing Then If Not WorksheetExists(Range("C2").Text) Then Set wks = Worksheets.Add(, Worksheets(Sheets.Count)) wks.Name = Range("C2").Text End If Intersect(Rows(Target.Row), Range("A:U")).Copy Worksheets(Range("C2").Text).Rows(Target.Row) ElseIf Not Intersect(Target, Range("F3:F382")) Is Nothing Then If Not WorksheetExists(Range("F2").Text) Then Set wks = Worksheets.Add(, Worksheets(Sheets.Count)) wks.Name = Range("F2").Text End If Intersect(Rows(Target.Row), Columns("A:U")).Copy Worksheets(Range("F2").Text).Rows(Target.Row) End If wksThisSheet.Activate Application.ScreenUpdating = True End Sub Private Function WorksheetExists(SheetName As String) As Boolean Dim wks As Worksheet WorksheetExists = False For Each wks In Worksheets If LCase(wks.Name) = LCase(SheetName) Then WorksheetExists = True Exit Function End If Next wks End Function <Campbell wrote in message ... I am a novice excel user but need help with a macro. I have a spreadsheet with 21 columns A to U on sheet 1. I would like if information is entered into column C or column F the row, Column A to U would be copied to new sheet with name of the data found in either column C or F. If the name sheet already rewrite to the named sheet. The header row is A2 to U2 Data is in A3:U382 There will be a maximum of twenty different text values in the C and F columns. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Create new sheets from data in either of two columns
Slightly simplified version of previous post:
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim wksThisSheet As Worksheet Set wksThisSheet = ActiveSheet Application.ScreenUpdating = False If Not Intersect(Target, Range("C3:C382")) Is Nothing Then If Not WorksheetExists(Range("C2").Text) Then _ Worksheets.Add(, Worksheets(Sheets.Count)).Name = _ Range("C2").Text Intersect(Rows(Target.Row), Range("A:U")).Copy Worksheets(Range("C2").Text).Rows(Target.Row) ElseIf Not Intersect(Target, Range("F3:F382")) Is Nothing Then If Not WorksheetExists(Range("F2").Text) Then _ Worksheets.Add(, Worksheets(Sheets.Count)).Name = _ Range("F2").Text Intersect(Rows(Target.Row), Columns("A:U")).Copy Worksheets(Range("F2").Text).Rows(Target.Row) End If wksThisSheet.Activate Application.ScreenUpdating = True End Sub Private Function WorksheetExists(SheetName As String) As Boolean Dim wks As Worksheet WorksheetExists = False For Each wks In Worksheets If LCase(wks.Name) = LCase(SheetName) Then WorksheetExists = True Exit Function End If Next wks End Function "Bob Kilmer" wrote in message ... Right-click the main sheet tab. Select View Code. Paste the following code there. Test to see if you get the results you expect. You may want to use a duplicate copy of your workbook so as not to imperil real data. Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim wks As Worksheet Dim wksThisSheet As Worksheet Set wksThisSheet = ActiveSheet Application.ScreenUpdating = False If Not Intersect(Target, Range("C3:C382")) Is Nothing Then If Not WorksheetExists(Range("C2").Text) Then Set wks = Worksheets.Add(, Worksheets(Sheets.Count)) wks.Name = Range("C2").Text End If Intersect(Rows(Target.Row), Range("A:U")).Copy Worksheets(Range("C2").Text).Rows(Target.Row) ElseIf Not Intersect(Target, Range("F3:F382")) Is Nothing Then If Not WorksheetExists(Range("F2").Text) Then Set wks = Worksheets.Add(, Worksheets(Sheets.Count)) wks.Name = Range("F2").Text End If Intersect(Rows(Target.Row), Columns("A:U")).Copy Worksheets(Range("F2").Text).Rows(Target.Row) End If wksThisSheet.Activate Application.ScreenUpdating = True End Sub Private Function WorksheetExists(SheetName As String) As Boolean Dim wks As Worksheet WorksheetExists = False For Each wks In Worksheets If LCase(wks.Name) = LCase(SheetName) Then WorksheetExists = True Exit Function End If Next wks End Function <Campbell wrote in message ... I am a novice excel user but need help with a macro. I have a spreadsheet with 21 columns A to U on sheet 1. I would like if information is entered into column C or column F the row, Column A to U would be copied to new sheet with name of the data found in either column C or F. If the name sheet already rewrite to the named sheet. The header row is A2 to U2 Data is in A3:U382 There will be a maximum of twenty different text values in the C and F columns. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Create new sheets from data in either of two columns
On Sat, 14 Aug 2004 23:36:02 -0400, "Bob Kilmer"
wrote: Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim wksThisSheet As Worksheet Set wksThisSheet = ActiveSheet Application.ScreenUpdating = False If Not Intersect(Target, Range("C3:C382")) Is Nothing Then If Not WorksheetExists(Range("C2").Text) Then _ Worksheets.Add(, Worksheets(Sheets.Count)).Name = _ Range("C2").Text Intersect(Rows(Target.Row), Range("A:U")).Copy Worksheets(Range("C2").Text).Rows(Target.Row) ElseIf Not Intersect(Target, Range("F3:F382")) Is Nothing Then If Not WorksheetExists(Range("F2").Text) Then _ Worksheets.Add(, Worksheets(Sheets.Count)).Name = _ Range("F2").Text Intersect(Rows(Target.Row), Columns("A:U")).Copy Worksheets(Range("F2").Text).Rows(Target.Row) End If wksThisSheet.Activate Application.ScreenUpdating = True End Sub Private Function WorksheetExists(SheetName As String) As Boolean Dim wks As Worksheet WorksheetExists = False For Each wks In Worksheets If LCase(wks.Name) = LCase(SheetName) Then WorksheetExists = True Exit Function End If Next wks End Function Bob thanks for your macros ,but I am having a problem with where as when I right click on the tab paste the macro I get a Macro dialogue box asking a for a name to be entered. When I try F8 to step through the code it will not permit me to do so. Any ideas? |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Create new sheets from data in either of two columns
Hmmm...
I am able to: 1. Copy the code from Option Explicit to End Function (inclusive) 2. Open a new workbook. 3. Right click on any sheet tab (Sheet1, for instance). 4. Select all (press Ctrl+A) (The only text you'll see is "Option Explicit.") 5. Right-click ON the selection. 6. Choose Paste. This should paste the code into the module. I am using Excel 2002 on Windows 2K Pro. Try the above steps as stated and let me know how it turns out. I am not familiar with a macro dialog poping up as you describe. Bob <Campbell wrote in message ... On Sat, 14 Aug 2004 23:36:02 -0400, "Bob Kilmer" wrote: Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim wksThisSheet As Worksheet Set wksThisSheet = ActiveSheet Application.ScreenUpdating = False If Not Intersect(Target, Range("C3:C382")) Is Nothing Then If Not WorksheetExists(Range("C2").Text) Then _ Worksheets.Add(, Worksheets(Sheets.Count)).Name = _ Range("C2").Text Intersect(Rows(Target.Row), Range("A:U")).Copy Worksheets(Range("C2").Text).Rows(Target.Row) ElseIf Not Intersect(Target, Range("F3:F382")) Is Nothing Then If Not WorksheetExists(Range("F2").Text) Then _ Worksheets.Add(, Worksheets(Sheets.Count)).Name = _ Range("F2").Text Intersect(Rows(Target.Row), Columns("A:U")).Copy Worksheets(Range("F2").Text).Rows(Target.Row) End If wksThisSheet.Activate Application.ScreenUpdating = True End Sub Private Function WorksheetExists(SheetName As String) As Boolean Dim wks As Worksheet WorksheetExists = False For Each wks In Worksheets If LCase(wks.Name) = LCase(SheetName) Then WorksheetExists = True Exit Function End If Next wks End Function Bob thanks for your macros ,but I am having a problem with where as when I right click on the tab paste the macro I get a Macro dialogue box asking a for a name to be entered. When I try F8 to step through the code it will not permit me to do so. Any ideas? |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Create new sheets from data in either of two columns
On Sun, 15 Aug 2004 20:15:15 -0400, "Bob Kilmer"
wrote: Hmmm... I am able to: 1. Copy the code from Option Explicit to End Function (inclusive) 2. Open a new workbook. 3. Right click on any sheet tab (Sheet1, for instance). 4. Select all (press Ctrl+A) (The only text you'll see is "Option Explicit.") 5. Right-click ON the selection. 6. Choose Paste. This should paste the code into the module. I am using Excel 2002 on Windows 2K Pro. Try the above steps as stated and let me know how it turns out. I am not familiar with a macro dialog poping up as you describe. Bob Bob, For some reason in the VB Tools --- Options the Require Variable Declaration was unchecked. I am having limited success with this code, where it has created additional the two sheets which is the name of the two header columns. There is no data in the two newly created sheets however. In my original post I said that it was Column C however it is Column D, so I changed all the references C to D. Plus I got rid of a some blank columns So it is now A:Q , all the amended are in lower case. Columns D and F already have the text data completed and this will not change. Columns E and G are numerical data inputted manually periodically. What I is the data from D3:D382 and F3:F382 to be their own sheets e.g A B C D E F G 2 Time Date Gr NM1 HiS NM2 AiS 3 Thomas Lloyd 4 Austin Samuel 13 Samuel Bilton 20 Newton Thomas So from the example Thomas, Lloyd, Austin, Samuel, Bilton, Newton will all have their sheets. Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim wks As Worksheet Dim wksThisSheet As Worksheet Set wksThisSheet = ActiveSheet Application.ScreenUpdating = False If Not Intersect(Target, Range("d3:d382")) Is Nothing Then If Not WorksheetExists(Range("d2").Text) Then Set wks = Worksheets.Add(, Worksheets(Sheets.Count)) wks.Name = Range("d2").Text End If Intersect(Rows(Target.Row), Range("A:q")).Copy Worksheets(Range("d2").Text).Rows(Target.Row) ElseIf Not Intersect(Target, Range("F3:F382")) Is Nothing Then If Not WorksheetExists(Range("F2").Text) Then Set wks = Worksheets.Add(, Worksheets(Sheets.Count)) wks.Name = Range("F2").Text End If Intersect(Rows(Target.Row), Columns("A:q")).Copy Worksheets(Range("F2").Text).Rows(Target.Row) End If wksThisSheet.Activate Application.ScreenUpdating = True End Sub Private Function WorksheetExists(SheetName As String) As Boolean Dim wks As Worksheet WorksheetExists = False For Each wks In Worksheets If LCase(wks.Name) = LCase(SheetName) Then WorksheetExists = True Exit Function End If Next wks End Function |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Create new sheets from data in either of two columns
3a. Select View Code.
"Bob Kilmer" wrote in message ... Hmmm... I am able to: 1. Copy the code from Option Explicit to End Function (inclusive) 2. Open a new workbook. 3. Right click on any sheet tab (Sheet1, for instance). 4. Select all (press Ctrl+A) (The only text you'll see is "Option Explicit.") 5. Right-click ON the selection. 6. Choose Paste. This should paste the code into the module. I am using Excel 2002 on Windows 2K Pro. Try the above steps as stated and let me know how it turns out. I am not familiar with a macro dialog poping up as you describe. Bob <Campbell wrote in message ... On Sat, 14 Aug 2004 23:36:02 -0400, "Bob Kilmer" wrote: Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim wksThisSheet As Worksheet Set wksThisSheet = ActiveSheet Application.ScreenUpdating = False If Not Intersect(Target, Range("C3:C382")) Is Nothing Then If Not WorksheetExists(Range("C2").Text) Then _ Worksheets.Add(, Worksheets(Sheets.Count)).Name = _ Range("C2").Text Intersect(Rows(Target.Row), Range("A:U")).Copy Worksheets(Range("C2").Text).Rows(Target.Row) ElseIf Not Intersect(Target, Range("F3:F382")) Is Nothing Then If Not WorksheetExists(Range("F2").Text) Then _ Worksheets.Add(, Worksheets(Sheets.Count)).Name = _ Range("F2").Text Intersect(Rows(Target.Row), Columns("A:U")).Copy Worksheets(Range("F2").Text).Rows(Target.Row) End If wksThisSheet.Activate Application.ScreenUpdating = True End Sub Private Function WorksheetExists(SheetName As String) As Boolean Dim wks As Worksheet WorksheetExists = False For Each wks In Worksheets If LCase(wks.Name) = LCase(SheetName) Then WorksheetExists = True Exit Function End If Next wks End Function Bob thanks for your macros ,but I am having a problem with where as when I right click on the tab paste the macro I get a Macro dialogue box asking a for a name to be entered. When I try F8 to step through the code it will not permit me to do so. Any ideas? |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Multiple Sheets (Need to create 500 individual sheets in one workbook, pulling DATA | Excel Worksheet Functions | |||
CREATE NEW WORKBOOK AND SHEETS BASED ON COLUMN DATA | Excel Worksheet Functions | |||
Create a list of data from same cell but different sheets | Excel Discussion (Misc queries) | |||
How do I create a summary worksheet that references data in other sheets? | Excel Worksheet Functions | |||
create a data-series based on two different columns of data ? | Charts and Charting in Excel |