Link to home
Start Free TrialLog in
Avatar of esbyrt
esbyrtFlag for Canada

asked on

Need a macro to copy all rows with a matching field to a different worksheet

I have a list of employees with a Business Unit code such as 4001. I need a macro or vba code that will go through the worksheet and copy all rows with the same business code to the adjacent worksheet starting at the first blank row. Is that possible? I have attached a short demo spreadsheet.
Thanks!Excel-Forum-Query-Sheet.xlsx
Avatar of Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj)
Flag of India image

Please try this...
In the attached click the button on 2017 Salaries Sheet to run the code and see if this is what you were trying to achieve.
Sub SplitData()
Dim sws As Worksheet, dws As Worksheet, temp As Worksheet
Dim slr As Long, dlr As Long, tlr As Long
Dim rng As Range, cell As Range
Dim BCode

Application.ScreenUpdating = False
Set sws = Sheets("2017 Salaries")
lr = sws.Cells(Rows.Count, 2).End(xlUp).Row

Sheets.Add(before:=Sheets(1)).Name = "Temp"
Set temp = ActiveSheet
sws.Range("H2:H" & lr).Copy temp.Range("A1")
tlr = temp.Cells(Rows.Count, 1).End(xlUp).Row
temp.Sort.SortFields.Clear
temp.Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With temp.Sort
    .SetRange Range("A1:A" & tlr)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Set rng = temp.Range("A1:A" & tlr)

For Each cell In rng
   If cell.Value <> BCode Then
      BCode = cell.Value
      With sws.Rows(1)
         .AutoFilter field:=7, Criteria1:=BCode
         On Error Resume Next
         Set dws = Sheets("Acct " & BCode)
         On Error GoTo 0
         If dws Is Nothing Then
            Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Acct " & BCode
            Set dws = ActiveSheet
         End If
         dws.Cells.Clear
         sws.Range("B1:M" & lr).SpecialCells(xlCellTypeVisible).Copy dws.Range("B1")
         dws.Columns.AutoFit
      End With
   End If
   Set dws = Nothing
Next cell
sws.AutoFilterMode = 0
Application.DisplayAlerts = False
temp.Delete
sws.Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Sheets have been created for all the individual Business Codes.", vbInformation, "Done!"
End Sub

Open in new window

Excel-Forum-Query-Sheet.xlsm
Take a look at Advanced Filter feature.

You can filter and copy to another location.

Or you can create a Pivot table and use the code as a Page Filter and have the pivot created on separate sheets filtered by code.

Thanks
Rob H
@Rob

The same task can be done with various options available including Formulas, Pivot Table, Advanced Filter etc, but please look at the Asker's requirement and I think he made his requirement pretty clear. Isn't it?
I need a macro or vba code
And obviously Asker didn't ask like "How can it be done?"
The fact that the asker quoted "macro or vba code" would suggest that they don't understand that they are effectively one and the same so I read it as they are looking for alternatives.

If a user is aware of vba being used in more advanced situations but is not aware of a standard non-vba feature, they may assume that their situation is sufficiently advanced to require vba. Therefore, referring to a standard feature does not do any harm.

With any question that I read I would rather start with analysing the situation and suggest solutions rather than starting at the point of an assumed requirement for a specific solution. The industry in which I work has a very good model for solving problems; step 1 is to identify problem and step 2 is to identify all possible solutions.

Thanks
Rob H
With any question that I read I would rather start with analysing the situation and suggest solutions rather than starting at the point of an assumed requirement for a specific solution.

I think in this case Asker was pretty clear about his requirement.
And of course that is the reason why you pop up in some solved questions also.

I normally classify Askers in two categories, one when Askers are pretty clear about their requirements and in that case I don't try to confuse them and another where Askers are not well skilled and don't know what method will best suit their requirements.

Nothing personal Rob. I said what I felt. :)
Please disregard if you disagree with me. :)
No worries, no offence taken. :)

I agree with your last paragraph and I do pretty much the same. In this case I had taken the quote of "macro or vba code" as meaning that they were not well skilled; no disrespect to the asker intended.

To use another analogy, if you went into a reputable hardware store and asked for a specific tool because you knew that tool would do what you needed, you might expect the salesman to check what you were going to use it for before just selling you what you were asking for. Likewise, if you went into a hardware store and explained what job you had to do, you would expect them to recommend the appropriate tool and not try to sell you something that wasn't required for the job; thinking of the phrase "Using a sledgehammer to crack a nut".

Thanks
Rob
Interesting. :)
As for my comments on solved questions; I often check the solved questions to see if there is something that I could have learned from solutions provided by other EE members. In doing so, if there is something in the question that does not appear to have been addressed in the comments then I will make a comment.

For example, the question in which you were involved here earlier today:

https://www.experts-exchange.com/questions/28957943/Excel-formula-if.html

It did not seem that anyone had pointed out that the number of characters in the text strings were incorrect. It seemed that all comments were rushing ahead with alternative solutions rather than analysing the issue to see that the criteria for the IF statements would never be true because of the miscount of characters.

Regards
Rob

PS Apologies to esbyrt for taking over his thread with this discussion. Feel free to raise a request for attention to have the comments which are irrelevant to the question removed.
You are right Rob. I also noticed that but assumed that at least Asker can perform this simple maths by counting the characters of the keyword being search in the string. Then I assumed that the string may contain a leading space and that may be case sometimes when data is imported from other programs so I offered him a different solution. Of course you raised the correct point there. :)
Avatar of esbyrt

ASKER

Thanks Subodh and Rob for your answers. First off, no I didn't know advanced filtering could do the job. I've had a quick look at it and get a message that I can only copy to the active sheet. I need to copy the matching rows to the next sheet.
Rob can you give me a quick run through on how to use that?
Subodh I downloaded the excel sheet you attached but once it's open it asks for a Microsoft Account to sign into and it doesn't like mine. If you have put the code in there it won't run. Can you re-post it?
Thanks!
ASKER CERTIFIED SOLUTION
Avatar of Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj)
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
When starting the Adv Filter wizard put the cursor on the destination sheet in a blank area.
Avatar of esbyrt

ASKER

Thanks so much Subodh! That works perfectly.

Rob - the advanced filter is still giving me grief but I can sure see how it would be handy for future reference. I will play around with it until I get that one figured out too. Thanks!
You're welcome. Thanks for the feedback.