Macro To Sort and Seperate Data on Serpate sheets from a Master Li

  • Thread starter Thread starter Troy
  • Start date Start date
T

Troy

I'm using excel 2003.

I have a worksheet full of maintenance data. Each row on this sheet has a
machine number, date, repair information, etc.

I'm trying to make a marco to search thur the list for a specific machine
number copy all the data from that row and paste it on a different sheet.
All of the entries for that machine number would then be copied to that new
sheet.


Does anyone know how to do this?
 
I'm using excel 2003.

I have a worksheet full of maintenance data.   Each row on this sheet has a
machine number, date, repair information, etc.  

I'm trying to make a marco to search thur the list for a specific machine
number copy all the data from that row and paste it on a different sheet.  
All of the entries for that machine number would then be copied to that new
sheet.

Does anyone know how to do this?
Click to expand...

There are quite a few different ways of accomplishing this. Some use
AdvanceFilters, etc, etc. I use a Collection object in conjunction
with an AutoFilter.

The below sub is called like this. Simply pass the column Letter in
that you want to base the split on. In this case, column A.

Sub tester()
ReportSplit "A"
End Sub

This is the workhorse sub that performs the split.

Sub ReportSplit(colLetter As String)
Dim shSource As Worksheet, shTarget As Worksheet
Dim LastCol As Integer
Dim rgSource As Range, rgUniques As Range, cl As Range
Dim BotRow As Long
Dim Uniques As Collection, Unique
Set Uniques = New Collection
Set shSource = ActiveWorkbook.ActiveSheet
LastCol = Cells.Find(what:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
BotRow = Cells.Find(what:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
With shSource
Set rgSource = .Range(Cells(1, 1), _
Cells(BotRow, LastCol))
Set rgUniques = .Range(Cells(2, colLetter), _
Cells(BotRow, colLetter))
End With
On Error Resume Next
For Each cl In rgUniques
Uniques.Add cl.Value, CStr(cl.Value)
Next cl
On Error GoTo 0
Application.ScreenUpdating = False
For Each Unique In Uniques
Set shTarget = Worksheets.Add(, ActiveSheet)
shTarget.Name = Unique
With rgSource
.Cells(1, colLetter).AutoFilter 1, Unique
.Copy shTarget.Range("A1")
End With
shSource.AutoFilterMode = False
Next Unique
Application.Goto shSource.Range("A1")
Application.ScreenUpdating = True
End Sub
 
I think i worded my question wrong. I do not want to create a new sheet.
the sheets that the data is sperated on would already be created.

So I woud have one source sheet with all machines on it. machine A, machine
b, etc. Everytime a machine breaks, the user will fill out a row of data
starting with the machine name. (example: "machine A"). These rows of data
will be filled out at random.

Then in the same workbook there would be several sub sheets, one for each
machine.

I want to hit a comand button on "Machine A's" sub sheets to run a query on
the source sheet to return all of the row entries that are listed as "Machine
A"

I'm new to programming so that's probably why I don't understand the link
you sent.
 
Thanks for the help. It's working!

However, it copies the previous data everytime the macro runs. Is there
anyway to make it were it only updates new data from the source sheet?
 
After the line

Next Cell

Add this

With Sheets(rng.Parent.Name)
.Range(.Cells(rng.Cells(1).Row + 1, 1), .Cells(.Rows.Count, 1)).EntireRow.ClearContents
End With
 
That cleared the data from the source sheet. And I don't want that to
happen. that data needs to stay. All I want to do is not recopy the same
information on the sub sheets everytime the macro runs.
 
yes please. You've been a great help today. I apperciate it.

This was your answer when I ask




I will post another macro this evening that will do what you want
 
OK

Add one dim line


Dim FieldNum2 As Integer



I use column D in my example to add the word"no" in every row that you copy
Change FieldNum2 to your column

FieldNum = 1
FieldNum2 = 4


Add one filter line

'Filter the range
rng.AutoFilter Field:=FieldNum, Criteria1:="=" & cell.Value
rng.AutoFilter Field:=FieldNum2, Criteria1:="<>no"


Replace

With Sheets(rng.Parent.Name)
.Range(.Cells(rng.Cells(1).Row + 1, 1), .Cells(.Rows.Count, 1)).EntireRow.ClearContents
End With


with

With Sheets(rng.Parent.Name)
.Range(.Cells(rng.Cells(1).Row + 1, FieldNum2), .Cells(LastRow(Sheets(rng.Parent.Name)), FieldNum2)).Value = "no"
End With
 
Hi Ron,

I used the code which copies the data in a different sheet, it worked great,
thank you, however one little change that i cant make, i want the macro to
name the sheets based on data on Col F2, how can i modify the code?

thanks
david
 
Hi Ron,

Yes, however i realized that that i may have multiple data in col q with the
same value in f2, so it wont work.
 
Back
Top