I need a macro that can extract data

Closed
excelmwangi
Posts
16
Registration date
Friday February 6, 2015
Status
Member
Last seen
June 5, 2015
- Feb 7, 2015 at 06:47 PM
vcoolio
Posts
1352
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
July 19, 2022
- Mar 26, 2015 at 09:46 PM
Hello,

I need help with creating a macro that can automatically copy data from different worksheets and put it into a master worksheet for a report. The problem is that it is on multiple rows on different worksheets and I don't want it to leave empty rows between if I just use the usual worksheet copy way. Please help

Related:

4 replies

vcoolio
Posts
1352
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
July 19, 2022
250
Feb 8, 2015 at 06:26 AM
Hello excelmwangi,

The easiest way to do this would be to add a selection criteria to your dataset. So, in the following code, I have added an asterisk "*" in Column A (for each sheet) as the criteria.


Sub CopyData()
Dim ws As Worksheet
Dim lRow As Long
Dim lCol As Integer

Application.ScreenUpdating = False

For Each ws In Worksheets
    If ws.Name = "Master" Then GoTo NextSheet
    
    ws.Select
    
    lRow = Range("A" & Rows.Count).End(xlUp).Row
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    For Each cell In Range("A2:A" & lRow)
        If cell.Value = "*" Then
            Range(Cells(cell.Row, "A"), Cells(cell.Row, lCol)).Copy
            Sheets("Master").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next cell

NextSheet:
Next ws
Sheets("Master").Range("A1:A" & Rows.Count).ClearContents
Sheets("Master").Select

Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "Data transfer complete", vbExclamation
End Sub


With this code, whichever row you place an asterisk by (ensure this is in Column A), in whichever sheet, the row of data will be copied to the "Master" sheet. The criteria is left behind.

You can have a look at my Test work book here:-

https://www.dropbox.com/s/dfy344w9u1w0509/Excelmwangi.xlsm?dl=0

to see if it works for you.

We can add an additional row of code if you want the transferred data cleared from the worksheets supplying the "Master" sheet. As the code is now, it clears the "Master" sheet prior to the data transfer to prevent duplicates while the data remains in each of the supplying sheets.

Kind regards,
vcoolio.
0
excelmwangi
Posts
16
Registration date
Friday February 6, 2015
Status
Member
Last seen
June 5, 2015

Feb 9, 2015 at 12:55 PM
Vcoolio, thank you for taking the time. However, when I copied the code and added the criteria, it is still not updating. Am I doing something wrong. Can I upload the document for you to see what's going on? Appreciate the help
0
excelmwangi
Posts
16
Registration date
Friday February 6, 2015
Status
Member
Last seen
June 5, 2015

Feb 9, 2015 at 01:03 PM
Vcoolio, thank you for taking the time. However, when I copied the code and added the criteria, it is still not updating. Am I doing something wrong. Can I upload the document for you to see what's going on? Appreciate
0
excelmwangi
Posts
16
Registration date
Friday February 6, 2015
Status
Member
Last seen
June 5, 2015

Feb 9, 2015 at 01:35 PM
Hey, Here is the link to my document. I put the * to the rows I want copied maybe you can help me diagnose and test. Thanks again.

https://www.dropbox.com/s/azbbvcnp4e8flsp/Planning%20Worksheet%20Western%20Vicariate%20-%20Copy.xlsm?dl=0
0
vcoolio
Posts
1352
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
July 19, 2022
250
Feb 10, 2015 at 01:31 AM
Hello excelmwangi,

Having now seen your workbook, its come to light that the problem is being caused by the merged cells. I unmerged all the cells in your work book, including in the "Master" sheet and this slightly amended code now works ok:-

Sub CopyData()
Dim ws As Worksheet
Dim lRow As Long
Dim lCol As Integer

Application.ScreenUpdating = False

For Each ws In Worksheets
    If ws.Name = "Master" Then GoTo NextSheet
    
    ws.Select
    
    lRow = Range("A" & Rows.Count).End(xlUp).Row
    lCol = Cells(5, Columns.Count).End(xlToLeft).Column
    
    For Each cell In Range("A5:A" & lRow)
        If cell.Value = "*" Then
            Range(Cells(cell.Row, "C"), Cells(cell.Row, lCol)).Copy
            Sheets("Master").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next cell

NextSheet:
Next ws

MsgBox "Data transfer complete", vbExclamation
Sheets("Master").Select

Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub


The merged cells can be reformatted without merging, they may just need a little more space. Also, remove the word "criteria" from wherever you have placed it in Column A on each sheet.

I hope this helps,

Kind regards,
vcoolio.
0
excelmwangi
Posts
16
Registration date
Friday February 6, 2015
Status
Member
Last seen
June 5, 2015

Feb 10, 2015 at 07:40 PM
Thank you so much. My last question would be when I update the master, it duplicates, What code can I add to clear the contents before updating so I don't have duplicate. You have been very helpful thanks again.
0
TrowaD
Posts
2886
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
June 27, 2022
515
Feb 12, 2015 at 11:23 AM
Hi Excelmwangi,

Vcoolio is away for a few days and has asked me to see if you needed any help.

Paste the following code lines after the 6th and before the 8th code line:
Sheets("Master").Select
lRow = Range("B" & Rows.Count).End(xlUp).Row
Range("B5:U" & lRow).ClearContents 


Let us know if you have any questions.

Best regards,
Trowa
0
excelmwangi
Posts
16
Registration date
Friday February 6, 2015
Status
Member
Last seen
June 5, 2015

Feb 13, 2015 at 03:52 AM
Hi TrowaD,
Thank you for helping me. I copied that code and it doesn't work. I've tried everything but it seems imposible. I've uploaded my document maybe you can see what am doing wrong. I want excel to pick up the rows on the other worksheets with a * as Vcoolio advised and before it copies to master to delete the contents in the master so it doesn't duplicate. Let me know what you think. Thanks again
Here is my drop box link with the document.
https://www.dropbox.com/s/vpk6m8kxc5k6ye7/Test%20Planning%20Worksheet%20Western%20Vicariate%20-%20Copy.xlsm?dl=0
0
vcoolio
Posts
1352
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
July 19, 2022
250 > excelmwangi
Posts
16
Registration date
Friday February 6, 2015
Status
Member
Last seen
June 5, 2015

Feb 13, 2015 at 09:00 PM
Hello Excelmwangi,

I'm back. But not for long. I have to leave again tomorrow for another stint in the wilderness.

The following amended code should work for you:-

Sub CopyData()
Dim ws As Worksheet
Dim lRow As Long
Dim lCol As Integer

Application.ScreenUpdating = False

Sheets("Master").Select
Sheets("Master").Range("B5:U" & Rows.Count).ClearContents

For Each ws In Worksheets
    If ws.Name = "Master" Then GoTo NextSheet
    
    ws.Select
    
    lRow = Range("A" & Rows.Count).End(xlUp).Row
    lCol = Cells(5, Columns.Count).End(xlToLeft).Column
    
    For Each cell In Range("A5:A" & lRow)
        If cell.Value = "*" Then
            Range(Cells(cell.Row, "C"), Cells(cell.Row, lCol)).Copy
            Sheets("Master").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next cell

NextSheet:
Next ws

Sheets("Master").Select

Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub


You can see it work here in the test work book:-

https://www.dropbox.com/s/wqhg6m4c5icwys1/Excelmwangi%283%29.xlsm?dl=0

This is the latest work book that you uploaded to DropBox.

I hope you don't mind, but I had a good search through your work book and found a number of little things that interrupted the code and adjusted accordingly. It should all be OK now, I think!

BTW, I removed the message box as it became somewhat annoying!
You can click on the blue "Summarise" button to activate the code.

@ Trowa:-

Thanks for looking after the shop while I was away. Much appreciated.

Cheers Gentlemen,
vcoolio.
0
excelmwangi
Posts
16
Registration date
Friday February 6, 2015
Status
Member
Last seen
June 5, 2015
> vcoolio
Posts
1352
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
July 19, 2022

Feb 16, 2015 at 08:31 PM
Vcoolio, Thank you very much for your assistance. You've been very helpful. Thanks again
0
excelmwangi
Posts
16
Registration date
Friday February 6, 2015
Status
Member
Last seen
June 5, 2015
> vcoolio
Posts
1352
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
July 19, 2022

Feb 16, 2015 at 08:55 PM
By the way, what was distracting my code. I have it running on my larger worksheet but when i add a button for the summary it doesn't pick up the other worksheets, while the one you uploaded works perfect. What was it that you changed so I can change on my final. The macro works but the button skips some rows. Thanks again
0
vcoolio
Posts
1352
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
July 19, 2022
250
Feb 17, 2015 at 09:15 PM
Hello again Excelmwangi,

Just wondering, did you assign the macro to the button? I have a feeling that this could be why its not working for you.

Also, copy and paste the code from my latest test book:-

https://www.dropbox.com/s/ses74bfn90ta6d2/Excelmwangi%284%29.xlsm?dl=0

into your work book. I've made a couple of minor adjustments.

In the "Master" sheet, if the headings are in merged cells (rows 3 & 4), unmerge them and format the headings just in row 3 before applying the adjusted code from above.

Let me know how it goes.

Cheers,
vcoolio.
0
excelmwangi
Posts
16
Registration date
Friday February 6, 2015
Status
Member
Last seen
June 5, 2015

Feb 23, 2015 at 02:35 PM
Vcoolio, you've been super helpful but my workbook has a mind of its own. I did everything as you said and the code works fine, but when I assign the button to the macro, it only picks up the first worksheet and leaves the rest. However, when I go to macro and run it from the developer tab, it copies everything as it should. Wondering what it could be with the button. It's so much little things....whew. Thanks for experts like you. I uploaded my sheet maybe you can help. Hope the desert was good. Feels like I need a desert escape as well. Thanks again. Here is the workbook.

https://www.dropbox.com/s/b4g2w7b5jwzpx9k/Planning%20Worksheet%20Central%20Vicariate%20-%20Copy%20-%20Copy.xlsm?dl=0
0
vcoolio
Posts
1352
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
July 19, 2022
250 > excelmwangi
Posts
16
Registration date
Friday February 6, 2015
Status
Member
Last seen
June 5, 2015

Feb 23, 2015 at 06:09 PM
Hello Excelmwangi,

I have gone right through your work book and all seems in order. I found four entries with the asterisk which have data in the row beside it and they all transfer nicely once your button is pressed. I tried additional random entries and they all transferred to the Master sheet nicely.
There are a lot of rows marked with the asterisk but no data in them so these rows will not be transferred over.

The other thing to remember, and I don't think that I told you previously, is that the code does require an entry in Column C (Vicariate) for it to execute. This column is the code's reference and it "homes in", so to speak, on the cell reference in Column C from the bottom of the sheet (by rows) and from the far, far right of the sheet (by columns). A bit like cross hairs on a scope. These two lines of code are the ones involved with the "cross hair' scenario:-

lCol = Cells(5, Columns.Count).End(xlToLeft).Column
Range(Cells(cell.Row, "C"), Cells(cell.Row, lCol)).Resize(, 20).Copy


and when one cell is found, the code moves on to the next cell referenced by:-

Next cell

and then, when one sheet is searched:-

NextSheet;
Next ws

in the code.

Just to be sure, re-assign the macro to the button:-
- Right click on the button.
- Select Assign Macro.
- In the Assign Macro box which appears, click on CopyData.
- Click OK.

Let me know how it goes.

Cheers,
vcoolio.
0
excelmwangi
Posts
16
Registration date
Friday February 6, 2015
Status
Member
Last seen
June 5, 2015

Feb 23, 2015 at 11:54 PM
hello vcoolio,
For whatever reason it worked for you but when i press it, it doesn't even after i assign it to macro. I figured it wasn't the code since the code worked fine when I ran it straight from the run macro menu. I am glad actually that it picks up just the column C with an entry so all that is okay and that's why I had the 4 random ones with entries to test it. I will try it again tomorrow and see if it works. will let you know. I think in the past month I've gone through an excel boot camp. Didn't know it was capable of this much. You've been a great help so thank you again.
0
excelmwangi
Posts
16
Registration date
Friday February 6, 2015
Status
Member
Last seen
June 5, 2015

Feb 24, 2015 at 12:03 AM
Yea just tried it and it only populates the master from my first worksheet from the button again. Not even sure why that is anymore. Did it work on yours exactly with the button and the same arrangement when I uploaded it. It must be my excel software then....wow
0
vcoolio
Posts
1352
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
July 19, 2022
250 > excelmwangi
Posts
16
Registration date
Friday February 6, 2015
Status
Member
Last seen
June 5, 2015

Feb 24, 2015 at 12:41 AM
Hello again Old Friend,

Everything works fine at this end still, especially in your actual work book.

Lets go down another road. Try this code instead:-

Sub CopyItAgain()
Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim DestSht As Worksheet
    Dim DestRow As Long
    Dim LastRow As Long
    Set DestSht = Worksheets("Master")
    DestRow = DestSht.Range("B" & Rows.Count).End(xlUp).Row + 1

    For Each ws In Worksheets
        A = ws.Name
Select Case ws.Name
    Case "PSM", "CCHD", "DOI", "FG", "FSW", "GS", "MM", "SMD", "PM":
    With ws
    .UsedRange.AutoFilter Field:=1, Criteria1:="*"
    .UsedRange.Offset(4, 2).Copy
     DestSht.Cells(DestRow, 2).PasteSpecial xlPasteValues
    .UsedRange.AutoFilter
End With
    
    DestRow = DestSht.Range("B" & Rows.Count).End(xlUp).Row + 1

End Select
    Next ws
    
Sheets("Master").Range("B3:U" & Rows.Count).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12), Header:=xlYes
Application.ScreenUpdating = True

End Sub


This code actually uses the AutoFilter function and won't need a cell to home in on so this code will copy whatever you have on a row marked with the asterisk (even if the Vicariate in Column C is not filled in).

Enter this code in a separate module and just run it from Visual Basic without a button. If it works OK from there, then delete the old button and start afresh by creating a new button and assign the new macro to it. It would probably be best to do this in a copy of your work book instead of your actual work book.

Let me know how it pans out.

Cheers,
vcoolio.
0