Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need help to modify RDB code
Hi,
I have found RDB code of SplitInWorksheets which seems to do most of what I want. It copies rows from a list and splits the data into different worksheets with the name of a selected value, in my case its the Customer name. The problem I have is that when the code runs again it adds a new worksheet with an name error_00001 and so on. I would like to mod the code so that if the worksheet already exist delete the existing data and then copy. I would appreciate any help as I just seem to be going round in circles and still trying to learn . code below is a part of the macro which I thinks need modifying 'loop through the unique list in ws2 and filter/copy to a new sheet Lrow = .Cells(Rows.Count, "A").End(xlUp).Row For Each cell In .Range("A2:A" & Lrow) 'Filter the range My_Table.Range.AutoFilter Field:=FieldNum, Criteria1:="=" & _ Replace(Replace(Replace(cell.Value, "~", "~~"), "*", "~*"), "?", "~?") CCount = 0 On Error Resume Next CCount = My_Table.ListColumns(1).Range.SpecialCells(xlCellT ypeVisible).Areas(1).Cells.Count On Error GoTo 0 If CCount = 0 Then MsgBox "There are more than 8192 areas for the value : " & cell.Value _ & vbNewLine & "It is not possible to copy the visible data to a new worksheet." _ & vbNewLine & "Tip: Sort your data before you use this macro.", _ vbOKOnly, "Split in worksheets" Else Set WSNew = Worksheets.Add(after:=Sheets(Sheets.Count)) On Error Resume Next WSNew.Name = cell.Value If Err.Number 0 Then ErrNum = ErrNum + 1 WSNew.Name = "Error_" & Format(ErrNum, "0000") Err.Clear End If On Error GoTo 0 'Copy the visible data and use PasteSpecial to paste to the new worksheet My_Table.Range.SpecialCells(xlCellTypeVisible).Cop y With WSNew.Range("A1") .PasteSpecial xlPasteColumnWidths .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False .Select End With End If Thanks Winnie |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need help to modify RDB code
Hi Winnie
Use http://www.rondebruin.nl/copy5_5.htm And change this part Else Set WSNew = Sheets(cell.Text) Lr = LastRow(WSNew) Set DestRange = WSNew.Range("A" & Lr + 1) End If To Else Set WSNew = Sheets(cell.Text) WSNew.Cells.Clear Lr = 1 Set destrange = WSNew.Range("A" & Lr + 1) End If -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "winnie123" wrote in message ... Hi, I have found RDB code of SplitInWorksheets which seems to do most of what I want. It copies rows from a list and splits the data into different worksheets with the name of a selected value, in my case its the Customer name. The problem I have is that when the code runs again it adds a new worksheet with an name error_00001 and so on. I would like to mod the code so that if the worksheet already exist delete the existing data and then copy. I would appreciate any help as I just seem to be going round in circles and still trying to learn . code below is a part of the macro which I thinks need modifying 'loop through the unique list in ws2 and filter/copy to a new sheet Lrow = .Cells(Rows.Count, "A").End(xlUp).Row For Each cell In .Range("A2:A" & Lrow) 'Filter the range My_Table.Range.AutoFilter Field:=FieldNum, Criteria1:="=" & _ Replace(Replace(Replace(cell.Value, "~", "~~"), "*", "~*"), "?", "~?") CCount = 0 On Error Resume Next CCount = My_Table.ListColumns(1).Range.SpecialCells(xlCellT ypeVisible).Areas(1).Cells.Count On Error GoTo 0 If CCount = 0 Then MsgBox "There are more than 8192 areas for the value : " & cell.Value _ & vbNewLine & "It is not possible to copy the visible data to a new worksheet." _ & vbNewLine & "Tip: Sort your data before you use this macro.", _ vbOKOnly, "Split in worksheets" Else Set WSNew = Worksheets.Add(after:=Sheets(Sheets.Count)) On Error Resume Next WSNew.Name = cell.Value If Err.Number 0 Then ErrNum = ErrNum + 1 WSNew.Name = "Error_" & Format(ErrNum, "0000") Err.Clear End If On Error GoTo 0 'Copy the visible data and use PasteSpecial to paste to the new worksheet My_Table.Range.SpecialCells(xlCellTypeVisible).Cop y With WSNew.Range("A1") .PasteSpecial xlPasteColumnWidths .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False .Select End With End If Thanks Winnie |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need help to modify RDB code
Thanks for the reply.
I have followed your advice and copied the code, changed as suggested. Put the functions above the code. Also changed the code at the beginning so that it looked at a specific sheet Set My_Range = Worksheets("PriceData").Range("C1:G" & LastRow(Worksheets("PriceData"))) My_Range.Parent.Select and chaged the column to filter on as 4 as i want to filter on Col F But it ends up with the rows below the headers on the PriceData sheet being hidden. It also copies the name tabs correctly with header rows but no data below. All the data has been copied to the sheet which is the first value in Col F, ie F2 Have I done anything wrong, can you help again please Thanks Winnie "Ron de Bruin" wrote: Hi Winnie Use http://www.rondebruin.nl/copy5_5.htm And change this part Else Set WSNew = Sheets(cell.Text) Lr = LastRow(WSNew) Set DestRange = WSNew.Range("A" & Lr + 1) End If To Else Set WSNew = Sheets(cell.Text) WSNew.Cells.Clear Lr = 1 Set destrange = WSNew.Range("A" & Lr + 1) End If -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "winnie123" wrote in message ... Hi, I have found RDB code of SplitInWorksheets which seems to do most of what I want. It copies rows from a list and splits the data into different worksheets with the name of a selected value, in my case its the Customer name. The problem I have is that when the code runs again it adds a new worksheet with an name error_00001 and so on. I would like to mod the code so that if the worksheet already exist delete the existing data and then copy. I would appreciate any help as I just seem to be going round in circles and still trying to learn . code below is a part of the macro which I thinks need modifying 'loop through the unique list in ws2 and filter/copy to a new sheet Lrow = .Cells(Rows.Count, "A").End(xlUp).Row For Each cell In .Range("A2:A" & Lrow) 'Filter the range My_Table.Range.AutoFilter Field:=FieldNum, Criteria1:="=" & _ Replace(Replace(Replace(cell.Value, "~", "~~"), "*", "~*"), "?", "~?") CCount = 0 On Error Resume Next CCount = My_Table.ListColumns(1).Range.SpecialCells(xlCellT ypeVisible).Areas(1).Cells.Count On Error GoTo 0 If CCount = 0 Then MsgBox "There are more than 8192 areas for the value : " & cell.Value _ & vbNewLine & "It is not possible to copy the visible data to a new worksheet." _ & vbNewLine & "Tip: Sort your data before you use this macro.", _ vbOKOnly, "Split in worksheets" Else Set WSNew = Worksheets.Add(after:=Sheets(Sheets.Count)) On Error Resume Next WSNew.Name = cell.Value If Err.Number 0 Then ErrNum = ErrNum + 1 WSNew.Name = "Error_" & Format(ErrNum, "0000") Err.Clear End If On Error GoTo 0 'Copy the visible data and use PasteSpecial to paste to the new worksheet My_Table.Range.SpecialCells(xlCellTypeVisible).Cop y With WSNew.Range("A1") .PasteSpecial xlPasteColumnWidths .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False .Select End With End If Thanks Winnie |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need help to modify RDB code
Try it first in the workbook you can download from my site and see if it is working OK
http://www.rondebruin.nl/copy5.htm After that try it on your own data -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "winnie123" wrote in message ... Hi, I have found RDB code of SplitInWorksheets which seems to do most of what I want. It copies rows from a list and splits the data into different worksheets with the name of a selected value, in my case its the Customer name. The problem I have is that when the code runs again it adds a new worksheet with an name error_00001 and so on. I would like to mod the code so that if the worksheet already exist delete the existing data and then copy. I would appreciate any help as I just seem to be going round in circles and still trying to learn . code below is a part of the macro which I thinks need modifying 'loop through the unique list in ws2 and filter/copy to a new sheet Lrow = .Cells(Rows.Count, "A").End(xlUp).Row For Each cell In .Range("A2:A" & Lrow) 'Filter the range My_Table.Range.AutoFilter Field:=FieldNum, Criteria1:="=" & _ Replace(Replace(Replace(cell.Value, "~", "~~"), "*", "~*"), "?", "~?") CCount = 0 On Error Resume Next CCount = My_Table.ListColumns(1).Range.SpecialCells(xlCellT ypeVisible).Areas(1).Cells.Count On Error GoTo 0 If CCount = 0 Then MsgBox "There are more than 8192 areas for the value : " & cell.Value _ & vbNewLine & "It is not possible to copy the visible data to a new worksheet." _ & vbNewLine & "Tip: Sort your data before you use this macro.", _ vbOKOnly, "Split in worksheets" Else Set WSNew = Worksheets.Add(after:=Sheets(Sheets.Count)) On Error Resume Next WSNew.Name = cell.Value If Err.Number 0 Then ErrNum = ErrNum + 1 WSNew.Name = "Error_" & Format(ErrNum, "0000") Err.Clear End If On Error GoTo 0 'Copy the visible data and use PasteSpecial to paste to the new worksheet My_Table.Range.SpecialCells(xlCellTypeVisible).Cop y With WSNew.Range("A1") .PasteSpecial xlPasteColumnWidths .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False .Select End With End If Thanks Winnie |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need help to modify RDB code
Thanks Ron, I have got it to work.
Thanks very much, you make so much easier. just a little note when you run the code the 2nd time all the worksheets with the copied data on start on row 2 This happens on your workbook also. Ta Winnie "Ron de Bruin" wrote: Try it first in the workbook you can download from my site and see if it is working OK http://www.rondebruin.nl/copy5.htm After that try it on your own data -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "winnie123" wrote in message ... Hi, I have found RDB code of SplitInWorksheets which seems to do most of what I want. It copies rows from a list and splits the data into different worksheets with the name of a selected value, in my case its the Customer name. The problem I have is that when the code runs again it adds a new worksheet with an name error_00001 and so on. I would like to mod the code so that if the worksheet already exist delete the existing data and then copy. I would appreciate any help as I just seem to be going round in circles and still trying to learn . code below is a part of the macro which I thinks need modifying 'loop through the unique list in ws2 and filter/copy to a new sheet Lrow = .Cells(Rows.Count, "A").End(xlUp).Row For Each cell In .Range("A2:A" & Lrow) 'Filter the range My_Table.Range.AutoFilter Field:=FieldNum, Criteria1:="=" & _ Replace(Replace(Replace(cell.Value, "~", "~~"), "*", "~*"), "?", "~?") CCount = 0 On Error Resume Next CCount = My_Table.ListColumns(1).Range.SpecialCells(xlCellT ypeVisible).Areas(1).Cells.Count On Error GoTo 0 If CCount = 0 Then MsgBox "There are more than 8192 areas for the value : " & cell.Value _ & vbNewLine & "It is not possible to copy the visible data to a new worksheet." _ & vbNewLine & "Tip: Sort your data before you use this macro.", _ vbOKOnly, "Split in worksheets" Else Set WSNew = Worksheets.Add(after:=Sheets(Sheets.Count)) On Error Resume Next WSNew.Name = cell.Value If Err.Number 0 Then ErrNum = ErrNum + 1 WSNew.Name = "Error_" & Format(ErrNum, "0000") Err.Clear End If On Error GoTo 0 'Copy the visible data and use PasteSpecial to paste to the new worksheet My_Table.Range.SpecialCells(xlCellTypeVisible).Cop y With WSNew.Range("A1") .PasteSpecial xlPasteColumnWidths .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False .Select End With End If Thanks Winnie |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need help to modify RDB code
Yes, I forgot to delete this
'Set destrange = WSNew.Range("A" & Lr + 1) Remove the +1 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "winnie123" wrote in message ... Thanks Ron, I have got it to work. Thanks very much, you make so much easier. just a little note when you run the code the 2nd time all the worksheets with the copied data on start on row 2 This happens on your workbook also. Ta Winnie "Ron de Bruin" wrote: Try it first in the workbook you can download from my site and see if it is working OK http://www.rondebruin.nl/copy5.htm After that try it on your own data -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "winnie123" wrote in message ... Hi, I have found RDB code of SplitInWorksheets which seems to do most of what I want. It copies rows from a list and splits the data into different worksheets with the name of a selected value, in my case its the Customer name. The problem I have is that when the code runs again it adds a new worksheet with an name error_00001 and so on. I would like to mod the code so that if the worksheet already exist delete the existing data and then copy. I would appreciate any help as I just seem to be going round in circles and still trying to learn . code below is a part of the macro which I thinks need modifying 'loop through the unique list in ws2 and filter/copy to a new sheet Lrow = .Cells(Rows.Count, "A").End(xlUp).Row For Each cell In .Range("A2:A" & Lrow) 'Filter the range My_Table.Range.AutoFilter Field:=FieldNum, Criteria1:="=" & _ Replace(Replace(Replace(cell.Value, "~", "~~"), "*", "~*"), "?", "~?") CCount = 0 On Error Resume Next CCount = My_Table.ListColumns(1).Range.SpecialCells(xlCellT ypeVisible).Areas(1).Cells.Count On Error GoTo 0 If CCount = 0 Then MsgBox "There are more than 8192 areas for the value : " & cell.Value _ & vbNewLine & "It is not possible to copy the visible data to a new worksheet." _ & vbNewLine & "Tip: Sort your data before you use this macro.", _ vbOKOnly, "Split in worksheets" Else Set WSNew = Worksheets.Add(after:=Sheets(Sheets.Count)) On Error Resume Next WSNew.Name = cell.Value If Err.Number 0 Then ErrNum = ErrNum + 1 WSNew.Name = "Error_" & Format(ErrNum, "0000") Err.Clear End If On Error GoTo 0 'Copy the visible data and use PasteSpecial to paste to the new worksheet My_Table.Range.SpecialCells(xlCellTypeVisible).Cop y With WSNew.Range("A1") .PasteSpecial xlPasteColumnWidths .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False .Select End With End If Thanks Winnie |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need help to modify RDB code
Thanks once again,
working perfectly. Thanks for your help. "Ron de Bruin" wrote: Yes, I forgot to delete this 'Set destrange = WSNew.Range("A" & Lr + 1) Remove the +1 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "winnie123" wrote in message ... Thanks Ron, I have got it to work. Thanks very much, you make so much easier. just a little note when you run the code the 2nd time all the worksheets with the copied data on start on row 2 This happens on your workbook also. Ta Winnie "Ron de Bruin" wrote: Try it first in the workbook you can download from my site and see if it is working OK http://www.rondebruin.nl/copy5.htm After that try it on your own data -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "winnie123" wrote in message ... Hi, I have found RDB code of SplitInWorksheets which seems to do most of what I want. It copies rows from a list and splits the data into different worksheets with the name of a selected value, in my case its the Customer name. The problem I have is that when the code runs again it adds a new worksheet with an name error_00001 and so on. I would like to mod the code so that if the worksheet already exist delete the existing data and then copy. I would appreciate any help as I just seem to be going round in circles and still trying to learn . code below is a part of the macro which I thinks need modifying 'loop through the unique list in ws2 and filter/copy to a new sheet Lrow = .Cells(Rows.Count, "A").End(xlUp).Row For Each cell In .Range("A2:A" & Lrow) 'Filter the range My_Table.Range.AutoFilter Field:=FieldNum, Criteria1:="=" & _ Replace(Replace(Replace(cell.Value, "~", "~~"), "*", "~*"), "?", "~?") CCount = 0 On Error Resume Next CCount = My_Table.ListColumns(1).Range.SpecialCells(xlCellT ypeVisible).Areas(1).Cells.Count On Error GoTo 0 If CCount = 0 Then MsgBox "There are more than 8192 areas for the value : " & cell.Value _ & vbNewLine & "It is not possible to copy the visible data to a new worksheet." _ & vbNewLine & "Tip: Sort your data before you use this macro.", _ vbOKOnly, "Split in worksheets" Else Set WSNew = Worksheets.Add(after:=Sheets(Sheets.Count)) On Error Resume Next WSNew.Name = cell.Value If Err.Number 0 Then ErrNum = ErrNum + 1 WSNew.Name = "Error_" & Format(ErrNum, "0000") Err.Clear End If On Error GoTo 0 'Copy the visible data and use PasteSpecial to paste to the new worksheet My_Table.Range.SpecialCells(xlCellTypeVisible).Cop y With WSNew.Range("A1") .PasteSpecial xlPasteColumnWidths .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False .Select End With End If Thanks Winnie |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Modify Code | Excel Worksheet Functions | |||
help modify code | Excel Programming | |||
Modify existing code to dynamic code | Excel Programming | |||
Modify code in UDF | Excel Programming | |||
How to modify VBA code for Add-in? | Excel Programming |