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