Solved

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

Posted on 2016-07-18
14
42 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 28

Expert Comment

by:Subodh Tiwari (Neeraj)
Comment Utility
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
0
 
LVL 31

Expert Comment

by:Rob Henson
Comment Utility
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 28

Expert Comment

by:Subodh Tiwari (Neeraj)
Comment Utility
@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
 
LVL 31

Expert Comment

by:Rob Henson
Comment Utility
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 28

Expert Comment

by:Subodh Tiwari (Neeraj)
Comment Utility
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 31

Expert Comment

by:Rob Henson
Comment Utility
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 28

Expert Comment

by:Subodh Tiwari (Neeraj)
Comment Utility
Interesting. :)
0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
LVL 31

Expert Comment

by:Rob Henson
Comment Utility
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 28

Expert Comment

by:Subodh Tiwari (Neeraj)
Comment Utility
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
Comment Utility
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 28

Accepted Solution

by:
Subodh Tiwari (Neeraj) earned 500 total points
Comment Utility
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 31

Expert Comment

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

Author Closing Comment

by:esbyrt
Comment Utility
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 28

Expert Comment

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

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Drop Down List with Unique/Distinct Values (enhancing the Combo-Box with a few steps and a little code) David miller (dlmille) Intro Have you ever created a data validation list from a database field or spreadsheet column (e.g., Zip Codes or Co…
Dealing with unintended Excel Active-X resizing quirks (VBA code simulates "self correction") David Miller (dlmille) Intro Not everyone is a fan of Active-X controls in spreadsheets (as opposed to the UserForm approach, the older Form controls …
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

763 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now