Sorting Data from ont sheet to several sheets

[nighttrainrex]

Hi all hope this in the right area new to this, I have been usin
excel of a while but have no training in it in anyway here is my proble
I have made a form (1st one) to enter the service history of severa
mobile plants to a summary list, now I need to sort it from the summar
to indinidual sheets and sort them in order of date on the new sheet.

I have attached a copy of the work book if that helps to explain thing


cheer

+-------------------------------------------------------------------
|Filename: Sample Book2.xlsx
|Download: http://www.thecodecage.com/forumz/attachment.php?attachmentid=286
+-------------------------------------------------------------------

 

[Patrick Molloy]

The web site requires logging on - which requires registration. Sorry, I
can't help you because of that.
If you summarise your problem, it would assist.

 

[nighttrainrex]

Hi Patrick thanks for the resopnce I hope the following is ok

I have to enter the data for service history of about 40 mobile plan
Excavators, Dump Trucks ect

I have created a form that enters in the following order from Coloum
across the page Date, Plant Number(Plant 1), Cost of repair in $
repairs carried out, By Who & Date entered.

The data for all Plant is entered to Sheet1 renamed Summary in n
paticular order as it is as repairs / servicing are done.

What I would like to do is sort from the summary list to indivdua
sheets for each plant IE: Plant 1, Plant 2 ect

cheers re

 

[Joel]

Try this code. Make sure the plant names in column B match the sheet names.
One of the names in the summary sheet is missing a space between Plant and
the number of the plant.


Sub SplitSummary()

With Sheets("Summary")
RowCount = 2
Do While .Range("A" & RowCount) <> ""
Plant = .Range("B" & RowCount)

With Sheets(Plant)
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRowCount = LastRow + 1
Set NewRow = .Rows(NewRowCount)
End With

.Rows(RowCount).Copy Destination:=NewRow
RowCount = RowCount + 1
Loop
End With

For Each Sht In Sheets
If Sht.Name <> "Summary" Then
LastRow = Sht.Range("A" & Rows.Count).End(xlUp).Row
Sht.Rows("4:" & LastRow).Sort _
header:=xlNo, _
key1:=Sht.Range("A4"), _
order1:=xlAscending
End If

Next Sht

End Sub

 

[Joel]

I copied are the columns instead of skipping the column with the plant name.
the code below fixes this problem.

Sub SplitSummary()


With Sheets("Summary")
RowCount = 2
Do While .Range("A" & RowCount) <> ""
Plant = .Range("B" & RowCount)

With Sheets(Plant)
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Newrow = LastRow + 1
Sheets("Summary").Range("A" & RowCount).Copy _
Destination:=.Range("A" & Newrow)
Sheets("Summary").Range("C" & RowCount & ":F" & RowCount).Copy _
Destination:=.Range("B" & Newrow)
End With

RowCount = RowCount + 1
Loop
End With

For Each sht In Sheets
If sht.Name <> "Summary" Then

LastRow = sht.Range("A" & Rows.Count).End(xlUp).Row
sht.Rows("4:" & LastRow).Sort _
header:=xlNo, _
key1:=sht.Range("A4"), _
order1:=xlAscending
End If

Next sht

End Sub

 

[nighttrainrex]

Joel thanks for the reply I not sure if I am placing the code in th
right place I have tried pasting it into VBAproject - This Workbook an
get a runtime error 9 message same when I try it in the summary sheet a
I on the right track do I need to place it in all sheets or am I wa
off?

cheers rex

 

[Simon Lloyd]

Runtime error 9 normally means that the worksheet you have specifie
does not exist, it could be mis-spelled or have trailing or leadin
spaces

*How to add and run a Macro*1. *Copy* the macro above placing th
cursor to the left of the code box hold the *CTRL & Left Click,* the
*Right Click* selected code and *Copy.*
2. Open your workbook
3. Press the keys *ALT+F11* to open the Visual Basic Editor
4. Press the keys *ALT+I* to activate the *Insert menu*
5. *Press M* to insert a *Standard Module*
6. *Paste* the code by pressing the keys *CTRL+V*
7. Make any custom changes to the macro if needed at this time.
8. *Save the Macro* by pressing the keys *CTRL+S*
9. Press the keys *ALT+Q* to exit the Editor, and return to Excel.

*To Run the Macro...*
To run the macro from Excel, open the workbook, and press *ALT+F8* t
display the *Run Macro Dialog*. Double Click the macro's name to *Run
it.

Joel thanks for the reply I not sure if I am placing the code in th
right place I have tried pasting it into VBAproject - This Workbook an
get a runtime error 9 message same when I try it in the summary sheet a
I on the right track do I need to place it in all sheets or am I wa
off

cheers re

--
Simon Lloy

Regards
Simon Lloy
'Microsoft Office Help' (http://www.thecodecage.com

 

[nighttrainrex]

Thanks Simon that helped but still one problem with it, it runs once an
works as required but also brings up following error

Runtime error 9

when I press Debug I get


With Sheets(Plant) highlighted in yellow

going by your note earlier the name is not right so do I need to d
this for each sheet as in Plant 1, Plant 2 ect

 

[Simon Lloyd]

You don't need to add it simply CALL it from any point in your origina
code so you may have it in the *Private Sub cmdCancel_Click()* sub an
after you close your userform you can
Code
-------------------
Call SplitSummar
-------------------

Thanks Simon that helped it now seems to work fine just wondering can
add this code to my orginal form code so that it just happens auto or d
I need to run it as a seperate macr

The code for my form is as follows

Code
-------------------
Private Sub cmdCancel_Click(
Unload M
End Su

Private Sub cmdClear_Click(
For Each ctl In Me.Control
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" The
ctl.Value = "
ElseIf TypeName(ctl) = "CheckBox" The
ctl.Value = Fals
End I
Next ct
End Su

Private Sub cmdOK_Click(
Dim RowCount As Lon
Dim ctl As Contro
If Me.Txtdate.Value = "" The
MsgBox "Please enter Date.", vExclamation, "Work Sheet
Me.Txtdate.SetFocu
End I
If Me.Cboplant.Value = "" The
MsgBox "Please enter Plant from Dropdown List.", vExclamation, "Work Sheet
Me.Txtdate.SetFocu
End I
If Me.Txthours.Value = "" The
MsgBox "Please enter Hours.", vExclamation, "Work Sheet
Me.Txtdate.SetFocu
End I
If Me.Txtamount.Value = "" The
MsgBox "Please enter Amount.", vExclamation, "Work Sheet
Me.Txtamount.SetFocu
End I
If Me.Txtdetails.Value = "" The
MsgBox "Please enter Details.", vExclamation, "Work Sheet
Me.Txtdate.SetFocu
End I
If Me.Txtby.Value = "" The
MsgBox "Please enter Work By.", vExclamation, "Work Sheet
Me.Txtdate.SetFocu
End I
If Not IsNumeric(Me.Txtamount.Value) The
MsgBox "Amount Must Contain a Numeric Value.", vbExclamation, "Work Sheet
Me.Txtamount.SetFocu
Exit Su
End I
If Not IsDate(Me.Txtdate.Value) The
MsgBox "Please enter a Valid Date.", vbExclamation, "Work Sheet
Me.Txtdate.SetFocu
Exit Su
End I
RowCount = Worksheets("Summary").Range("A1").CurrentRegion.Rows.Coun
With Worksheets("Summary").Range("A1"
.Offset(RowCount, 0).Value = Me.Txtdate.Valu
.Offset(RowCount, 1).Value = Me.Cboplant.Valu
.Offset(RowCount, 2).Value = Me.Txthours.Valu
.Offset(RowCount, 3).Value = Me.Txtdetails.Valu
.Offset(RowCount, 4).Value = Me.Txtamount.Valu
.Offset(RowCount, 5).Value = Me.Txtby.Valu
.Offset(RowCount, 6).Value = Format(Now, "dd/mm/yyyy hh:nn:ss"
End Wit
For Each ctl In Me.Control
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" The
ctl.Value = "
ElseIf TypeName(ctl) = "CheckBox" The
ctl.Value = Fals
End I
Next ct
End Su






Private Sub UserForm_Click(

End Su
-------------------

--
Simon Lloy

Regards
Simon Lloy
'Microsoft Office Help' (http://www.thecodecage.com

 

[nighttrainrex]

Simon again thanks that works fine but again just one mor thing can it
be made to sort only new entrys at the moment if no new entry is made it
adds the last entry to the indevidual sheets

rex

 

[Simon Lloyd]

I haven't looked at your attachment, if you are entering dates then yo
sort by the date field either ascending or descending depending on you
preference

Simon again thanks that works fine but again just one mor thing can i
be made to sort only new entrys at the moment if no new entry is made i
adds the last entry to the indevidual sheet

re

--
Simon Lloy

Regards
Simon Lloy
'Microsoft Office Help' (http://www.thecodecage.com

 

[nighttrainrex]

Simon and all answered my call Thanks very much you help has bee
great:Bgr