Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
excel sheet bootom half sheet goes behind top part of sheet | Excel Worksheet Functions | |||
Duplicate sheet, autonumber sheet, record data on another sheet | Excel Worksheet Functions | |||
How do I select price from sheet.b where sheet.a part no = sheet.b | Excel Worksheet Functions | |||
relative sheet references ala sheet(-1)!B11 so I can copy a sheet. | Excel Discussion (Misc queries) | |||
Inserting a row in sheet A should Insert a row in sheet B, removing a row in Sheet A should remove the corresponding row in sheet B | Excel Programming |