Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Report Question?
Can someone help for this kind of report?
I have a worksheet range from A1:J3788. Column 1 contains the date informations. Column 2 to 9 contains customers name. How to write each individual customer to a new sheet which contain only 2 columns i.e. date and name. e.g. In master record (Sheet1) contains 29/10/2003 Albert Robert Bobby....etc 30/10/2003 Robert Bobby Albert ....etc. The sheet name will be auto named after the name of the customer. So in sheet Albert will be 29/10/2003 Albert 30/10/2003 Albert In sheet Robert will be 29/10/2003 Robert 30/10/2003 Robert In sheet Bobby will be 29/10/2003 Bobby 30/10/2003 Bobby The routine will start from the first row of sheet1 until the last row. Thanks you. ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Report Question?
Michael,
Try the code below, with the sheet active. This assumes there are headers in row 1. HTH, Bernie MS Excel MVP Sub TryNow() Dim myCell As Range Dim myRange As Range Dim mySht As Worksheet Dim mySrc As Worksheet Dim myVal As String Application.ScreenUpdating = False ActiveSheet.Copy Sheets(1) Set mySrc = ActiveSheet Set myRange = mySrc.Range("B2:J3788") While Application.CountBlank(myRange) < myRange.Cells.Count Set myRange = myRange.SpecialCells(xlCellTypeConstants, 2) myVal = myRange(1).Value Set mySht = Worksheets.Add mySrc.Activate mySht.Name = myVal mySht.Range("A:A").NumberFormat = "mm/dd/yyyy" For Each myCell In myRange If myCell.Value = myVal Then With mySht.Range("A65536").End(xlUp)(2) .Value = Cells(myCell.Row, 1).Value .Offset(0, 1).Value = myCell.Value End With myCell.ClearContents End If Next myCell mySht.Range("A:B").EntireColumn.AutoFit Set myRange = mySrc.Range("B2:J3788") Wend Application.DisplayAlerts = False mySrc.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub "Michael168" wrote in message ... Can someone help for this kind of report? I have a worksheet range from A1:J3788. Column 1 contains the date informations. Column 2 to 9 contains customers name. How to write each individual customer to a new sheet which contain only 2 columns i.e. date and name. e.g. In master record (Sheet1) contains 29/10/2003 Albert Robert Bobby....etc 30/10/2003 Robert Bobby Albert ....etc. The sheet name will be auto named after the name of the customer. So in sheet Albert will be 29/10/2003 Albert 30/10/2003 Albert In sheet Robert will be 29/10/2003 Robert 30/10/2003 Robert In sheet Bobby will be 29/10/2003 Bobby 30/10/2003 Bobby The routine will start from the first row of sheet1 until the last row. Thanks you. ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Report Question?
Hi! Bernie Deitrick,
Thanks for your fast help. A little problem exists. That is when I run the macro the second time, it gives me "run-time error 1004" stating that "cannot rename a sheet to the same name as another sheet". How to overcome this problem? I think all the newly created sheet need to be deleted before running. I need to run the macro at least on daily basic because the master record keep on updating daily. Your modification help needed and appreciated. Thank you. ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Report Question?
Michael,
The code below will work on subsequent trials. It will color any data that was tranfered as green - my way, though not the only way - to keep from double transferring data when you run it a second time. You can change the colorindex = 4 lines (two places) to another color that better pleases you. Note that you need to copy the function below as well into your code module. HTH, Bernie MS Excel MVP Sub TryNow2() Dim myCell As Range Dim myRange As Range Dim mySht As Worksheet Dim mySrc As Worksheet Dim myOrig As Worksheet Dim myVal As String Application.ScreenUpdating = False Set myOrig = ActiveSheet ActiveSheet.Copy Sheets(1) Set mySrc = ActiveSheet Set myRange = mySrc.Range("B2", Range("B2").CurrentRegion.SpecialCells(xlCellTypeL astCell)) While Application.CountBlank(myRange) < myRange.Cells.Count Set myRange = myRange.SpecialCells(xlCellTypeConstants, 2) myVal = myRange(1).Value If Not WorksheetExists(myVal) Then Set mySht = Worksheets.Add mySht.Name = myVal Else Set mySht = Worksheets(myVal) End If mySrc.Activate mySht.Range("A:A").NumberFormat = "mm/dd/yyyy" For Each myCell In myRange If myCell.Value = myVal Then If myCell.Interior.ColorIndex < 4 Then With mySht.Range("A65536").End(xlUp)(2) .Value = Cells(myCell.Row, 1).Value .Offset(0, 1).Value = myCell.Value myOrig.Range(myCell.Address).Interior.ColorIndex = 4 End With End If myCell.ClearContents End If Next myCell mySht.Range("A:B").EntireColumn.AutoFit Set myRange = mySrc.Range("B2:J3788") Wend Application.DisplayAlerts = False mySrc.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Function WorksheetExists(wksName As String) As Boolean Dim dummy_wks As Worksheet On Error Resume Next Set dummy_wks = Worksheets(wksName) If Err = 0 Then WorksheetExists = True Else WorksheetExists = False End If Set dummy_wks = Nothing End Function "Michael168" wrote in message ... Hi! Bernie Deitrick, Thanks for your fast help. A little problem exists. That is when I run the macro the second time, it gives me "run-time error 1004" stating that "cannot rename a sheet to the same name as another sheet". How to overcome this problem? I think all the newly created sheet need to be deleted before running. I need to run the macro at least on daily basic because the master record keep on updating daily. Your modification help needed and appreciated. Thank you. ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Report Question?
Aargh, forgot to change one line to account for the larger range
(possibly larger range) for subsequent runs. I also fixed a text wrapping problem. HTH, Bernie MS Excel MVP Sub TryNow2() Dim myCell As Range Dim myRange As Range Dim mySht As Worksheet Dim mySrc As Worksheet Dim myOrig As Worksheet Dim myVal As String Application.ScreenUpdating = False Set myOrig = ActiveSheet ActiveSheet.Copy Sheets(1) Set mySrc = ActiveSheet Set myRange = mySrc.Range("B2", _ Range("B2").CurrentRegion.SpecialCells(xlCellTypeL astCell)) While Application.CountBlank(myRange) < myRange.Cells.Count Set myRange = myRange.SpecialCells(xlCellTypeConstants, 2) myVal = myRange(1).Value If Not WorksheetExists(myVal) Then Set mySht = Worksheets.Add mySht.Name = myVal Else Set mySht = Worksheets(myVal) End If mySrc.Activate mySht.Range("A:A").NumberFormat = "mm/dd/yyyy" For Each myCell In myRange If myCell.Value = myVal Then If myCell.Interior.ColorIndex < 4 Then With mySht.Range("A65536").End(xlUp)(2) .Value = Cells(myCell.Row, 1).Value .Offset(0, 1).Value = myCell.Value myOrig.Range(myCell.Address).Interior.ColorIndex = 4 End With End If myCell.ClearContents End If Next myCell mySht.Range("A:B").EntireColumn.AutoFit Set myRange = mySrc.Range("B2", _ Range("B2").CurrentRegion.SpecialCells(xlCellTypeL astCell)) Wend Application.DisplayAlerts = False mySrc.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Function WorksheetExists(wksName As String) As Boolean Dim dummy_wks As Worksheet On Error Resume Next Set dummy_wks = Worksheets(wksName) If Err = 0 Then WorksheetExists = True Else WorksheetExists = False End If Set dummy_wks = Nothing End Function "Bernie Deitrick" wrote in message ... Michael, The code below will work on subsequent trials. It will color any data that was tranfered as green - my way, though not the only way - to keep from double transferring data when you run it a second time. You can change the colorindex = 4 lines (two places) to another color that better pleases you. Note that you need to copy the function below as well into your code module. HTH, Bernie MS Excel MVP Sub TryNow2() Dim myCell As Range Dim myRange As Range Dim mySht As Worksheet Dim mySrc As Worksheet Dim myOrig As Worksheet Dim myVal As String Application.ScreenUpdating = False Set myOrig = ActiveSheet ActiveSheet.Copy Sheets(1) Set mySrc = ActiveSheet Set myRange = mySrc.Range("B2", Range("B2").CurrentRegion.SpecialCells(xlCellTypeL astCell)) While Application.CountBlank(myRange) < myRange.Cells.Count Set myRange = myRange.SpecialCells(xlCellTypeConstants, 2) myVal = myRange(1).Value If Not WorksheetExists(myVal) Then Set mySht = Worksheets.Add mySht.Name = myVal Else Set mySht = Worksheets(myVal) End If mySrc.Activate mySht.Range("A:A").NumberFormat = "mm/dd/yyyy" For Each myCell In myRange If myCell.Value = myVal Then If myCell.Interior.ColorIndex < 4 Then With mySht.Range("A65536").End(xlUp)(2) .Value = Cells(myCell.Row, 1).Value .Offset(0, 1).Value = myCell.Value myOrig.Range(myCell.Address).Interior.ColorIndex = 4 End With End If myCell.ClearContents End If Next myCell mySht.Range("A:B").EntireColumn.AutoFit Set myRange = mySrc.Range("B2:J3788") Wend Application.DisplayAlerts = False mySrc.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Function WorksheetExists(wksName As String) As Boolean Dim dummy_wks As Worksheet On Error Resume Next Set dummy_wks = Worksheets(wksName) If Err = 0 Then WorksheetExists = True Else WorksheetExists = False End If Set dummy_wks = Nothing End Function "Michael168" wrote in message ... Hi! Bernie Deitrick, Thanks for your fast help. A little problem exists. That is when I run the macro the second time, it gives me "run-time error 1004" stating that "cannot rename a sheet to the same name as another sheet". How to overcome this problem? I think all the newly created sheet need to be deleted before running. I need to run the macro at least on daily basic because the master record keep on updating daily. Your modification help needed and appreciated. Thank you. ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Report Question?
Hi!Bernie Deitrick,
Thank you for trynow2() macro. Everything runs fine except when the cell value in the master contain only numeric number it gives the run-time error '1004' again stating "No cells were found". I try to figure out but cannot solve it myself. e.g. Mastersheet Record date cust1 cust2 cust3 cust4 cust5 .....etc 10/29/2003 albert robert bobby 2010 2011 10/29/2003 2020 kintown kampar robert 10/30/2003 robert bobby albert 10/31/2003 albert bobby robert niceguy Cust cells with name are cash sales customer and with numeric number are credit term customers. In this case how to solve this problem. On each individual report sheet, I would like to add in 1 more cell for each row-no from the master sheet so that it make me easy to trace against the mastersheet data. Hope this will not cause you a lot of trouble. Thanks & Regards Michael168 ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Report Question?
Michael,
Wherever this appears: ..SpecialCells(xlCellTypeConstants, 2) Change it to: ..SpecialCells(xlCellTypeConstants, 3) This change will make the macro work with numbers and string constants. It will still not work with formulas, so in your data base you can't use something like =AnotherCell. HTH, Bernie MS Excel MVP "Michael168" wrote in message ... Hi!Bernie Deitrick, Thank you for trynow2() macro. Everything runs fine except when the cell value in the master contain only numeric number it gives the run-time error '1004' again stating "No cells were found". I try to figure out but cannot solve it myself. e.g. Mastersheet Record date cust1 cust2 cust3 cust4 cust5 .....etc 10/29/2003 albert robert bobby 2010 2011 10/29/2003 2020 kintown kampar robert 10/30/2003 robert bobby albert 10/31/2003 albert bobby robert niceguy Cust cells with name are cash sales customer and with numeric number are credit term customers. In this case how to solve this problem. On each individual report sheet, I would like to add in 1 more cell for each row-no from the master sheet so that it make me easy to trace against the mastersheet data. Hope this will not cause you a lot of trouble. Thanks & Regards Michael168 ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Report Question?
For the second, request (adding the row number of the original data),
after the line .Offset(0, 1).Value = myCell.Value add the line .Offset(0, 2).Value = myCell.Row HTH, Bernie MS Excel MVP "Michael168" wrote in message ... Hi!Bernie Deitrick, Thank you for trynow2() macro. Everything runs fine except when the cell value in the master contain only numeric number it gives the run-time error '1004' again stating "No cells were found". I try to figure out but cannot solve it myself. e.g. Mastersheet Record date cust1 cust2 cust3 cust4 cust5 .....etc 10/29/2003 albert robert bobby 2010 2011 10/29/2003 2020 kintown kampar robert 10/30/2003 robert bobby albert 10/31/2003 albert bobby robert niceguy Cust cells with name are cash sales customer and with numeric number are credit term customers. In this case how to solve this problem. On each individual report sheet, I would like to add in 1 more cell for each row-no from the master sheet so that it make me easy to trace against the mastersheet data. Hope this will not cause you a lot of trouble. Thanks & Regards Michael168 ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Question on report writing. | Excel Discussion (Misc queries) | |||
Report Manager question | Excel Discussion (Misc queries) | |||
Automate Excel report to place certain data into existing report? | Excel Worksheet Functions | |||
Access Form In An Access Report (SubForm) Question | Links and Linking in Excel | |||
Help of Expense Report Question | Excel Discussion (Misc queries) |