new sheet
 

ron was the man and helped me out by writing this code for me. it goes
through a row of salesman, and makes a new sheet for each salesman. there
are duplicate entries for salesman, so it just adds more columns to that
sheet if the name repeats. i just need one more thing. when it is run
twice, all of the columns are repeated again on each sheet. is it possible
for the sheets to be erased each time and replaced? here is the code:

Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Lc As Long

Set ws1 = ActiveSheet
For Each cell In ws1.Range("J58:IV58").SpecialCells(xlConstants)
If SheetExists(cell.Value) = False Then
Set ws2 = Sheets.Add
On Error Resume Next
ws2.Name = cell.Value
On Error GoTo 0

ws1.Columns(1).Copy ws2.Range("A1")
ws1.Columns(cell.Column).Copy ws2.Range("B1")
ws2.Range("A1").Value = Date
ws2.Columns.AutoFit
Else
Set ws2 = Sheets(cell.Value)
Lc = Lastcol(ws2)
ws1.Columns(cell.Column).Copy ws2.Cells(1, Lc + 1)
ws2.Range("A1").Value = Date
End If
Next
End Sub

Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function


Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function

new sheet
 

Hi Steve

You can do two things before you run the macro
Delete all sheets or Clear all data on each sheet in a seperate macro

Try this (it delete all sheets exept hidden sheets and your Sales sheet)

Sub delete_sheets()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If sh.Name < "Sales" And sh.Visible = True Then
Application.DisplayAlerts = False
sh.delete
Application.DisplayAlerts = True
End If
Next
End Sub



--
Regards Ron de Bruin
http://www.rondebruin.nl


"steve" wrote in message ...
ron was the man and helped me out by writing this code for me. it goes
through a row of salesman, and makes a new sheet for each salesman. there
are duplicate entries for salesman, so it just adds more columns to that
sheet if the name repeats. i just need one more thing. when it is run
twice, all of the columns are repeated again on each sheet. is it possible
for the sheets to be erased each time and replaced? here is the code:

Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Lc As Long

Set ws1 = ActiveSheet
For Each cell In ws1.Range("J58:IV58").SpecialCells(xlConstants)
If SheetExists(cell.Value) = False Then
Set ws2 = Sheets.Add
On Error Resume Next
ws2.Name = cell.Value
On Error GoTo 0

ws1.Columns(1).Copy ws2.Range("A1")
ws1.Columns(cell.Column).Copy ws2.Range("B1")
ws2.Range("A1").Value = Date
ws2.Columns.AutoFit
Else
Set ws2 = Sheets(cell.Value)
Lc = Lastcol(ws2)
ws1.Columns(cell.Column).Copy ws2.Cells(1, Lc + 1)
ws2.Range("A1").Value = Date
End If
Next
End Sub

Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function


Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function

new sheet
 

Ron,

Works perfect now. Thanks for all your help man. i modified it a little bit:

Sub delete_sheets()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If sh.Name = "Dan" Or sh.Name = "Mike" Or sh.Name = "Jeff" _
Or sh.Name = "Keith" Or sh.Name = "David" Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next
End Sub

i validated the cells so these are the only options for salesman. that way,
if another sheet is created, this macro won't delete it.

Thanks again for all your help.

"steve" wrote:

ron was the man and helped me out by writing this code for me. it goes
through a row of salesman, and makes a new sheet for each salesman. there
are duplicate entries for salesman, so it just adds more columns to that
sheet if the name repeats. i just need one more thing. when it is run
twice, all of the columns are repeated again on each sheet. is it possible
for the sheets to be erased each time and replaced? here is the code:

Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Lc As Long

Set ws1 = ActiveSheet
For Each cell In ws1.Range("J58:IV58").SpecialCells(xlConstants)
If SheetExists(cell.Value) = False Then
Set ws2 = Sheets.Add
On Error Resume Next
ws2.Name = cell.Value
On Error GoTo 0

ws1.Columns(1).Copy ws2.Range("A1")
ws1.Columns(cell.Column).Copy ws2.Range("B1")
ws2.Range("A1").Value = Date
ws2.Columns.AutoFit
Else
Set ws2 = Sheets(cell.Value)
Lc = Lastcol(ws2)
ws1.Columns(cell.Column).Copy ws2.Cells(1, Lc + 1)
ws2.Range("A1").Value = Date
End If
Next
End Sub

Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function


Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function

new sheet
 

You can do it like this then Steve in one step

Sub delete_sheets()
Application.DisplayAlerts = False
Sheets(Array("Dan", "Mike", "Jeff", "Keith", "David")).delete
Application.DisplayAlerts = True
End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


"steve" wrote in message ...
Ron,

Works perfect now. Thanks for all your help man. i modified it a little bit:

Sub delete_sheets()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If sh.Name = "Dan" Or sh.Name = "Mike" Or sh.Name = "Jeff" _
Or sh.Name = "Keith" Or sh.Name = "David" Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next
End Sub

i validated the cells so these are the only options for salesman. that way,
if another sheet is created, this macro won't delete it.

Thanks again for all your help.

"steve" wrote:

ron was the man and helped me out by writing this code for me. it goes
through a row of salesman, and makes a new sheet for each salesman. there
are duplicate entries for salesman, so it just adds more columns to that
sheet if the name repeats. i just need one more thing. when it is run
twice, all of the columns are repeated again on each sheet. is it possible
for the sheets to be erased each time and replaced? here is the code:

Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Lc As Long

Set ws1 = ActiveSheet
For Each cell In ws1.Range("J58:IV58").SpecialCells(xlConstants)
If SheetExists(cell.Value) = False Then
Set ws2 = Sheets.Add
On Error Resume Next
ws2.Name = cell.Value
On Error GoTo 0

ws1.Columns(1).Copy ws2.Range("A1")
ws1.Columns(cell.Column).Copy ws2.Range("B1")
ws2.Range("A1").Value = Date
ws2.Columns.AutoFit
Else
Set ws2 = Sheets(cell.Value)
Lc = Lastcol(ws2)
ws1.Columns(cell.Column).Copy ws2.Cells(1, Lc + 1)
ws2.Range("A1").Value = Date
End If
Next
End Sub

Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function


Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function