Solved

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

Posted on 2016-07-18
14
51 Views
Last Modified: 2016-07-19
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
0
Comment
Question by:esbyrt
  • 7
  • 5
  • 2
14 Comments
 
LVL 30

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41718154
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
1
 
LVL 33

Expert Comment

by:Rob Henson
ID: 41718263
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
0
 
LVL 30

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41718960
@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?"
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 33

Expert Comment

by:Rob Henson
ID: 41718993
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
0
 
LVL 30

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41719083
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. :)
0
 
LVL 33

Expert Comment

by:Rob Henson
ID: 41719093
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
0
 
LVL 30

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41719100
Interesting. :)
0
 
LVL 33

Expert Comment

by:Rob Henson
ID: 41719102
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.
0
 
LVL 30

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41719140
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. :)
0
 

Author Comment

by:esbyrt
ID: 41719557
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!
0
 
LVL 30

Accepted Solution

by:
Subodh Tiwari (Neeraj) earned 500 total points
ID: 41719569
To apply the code to your own workbook, please follow these steps...

How to implement the code to your workbook:
1) Open your sample workbook you uploaded in post#1
2) press Alt+F11 to open VBA Editor
3) On VB Editor,  Insert --> Module
4) Paste the code given below into the opened code window
5) Close VB Editor
6)Save your workbook as Macro-Enabled Workbook.

To run the code:
Press Alt+F8 to open Macro Window --> Choose the macro from the available macro list --> Click on Run.


Code:
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

0
 
LVL 33

Expert Comment

by:Rob Henson
ID: 41719594
When starting the Adv Filter wizard put the cursor on the destination sheet in a blank area.
0
 

Author Closing Comment

by:esbyrt
ID: 41719682
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!
0
 
LVL 30

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41720098
You're welcome. Thanks for the feedback.
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

685 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question