Deriving data from Master database sheet

[aquaman21]

Hi everyone,

This is my first time here and I'm a self-admitted newbie at Excel. I think this might be a simple problem but I really, really, really don't know how to proceed. Any help would be great. Honestly. I'm using Microsoft Excel 2010.

Now in my Sheet 1, I have created a Table with data which I refer to as Master database.

It looks like this:



Date Last Name First Name Email Mobile Number
02/1/2016 James Henry abx@yxz.com
03/1/2016 Tim 76543-84344
04/1/2016 Wales A ygfd@ohf.com 78475-443495




Now basically this is input from consumers and sometimes we either have a entry for E-mail Address or for Mobile Number and sometimes it's blank. Now I am creating two other tables on a different sheet, same workbook.

One is called SMS database. One is called E-mail database.

Now whichever entry in my Master database has a mobile number (meaning it is not left blank in the mobile number column), I want all of that information to be automatically picked up from the Master database onto this SMS database sheet.

So I want it to look something like this:

Date Last Name First Name Email Mobile Number
03/1/2016 Tim 76543-8434
04/1/2016 Wales A ygfd@ohf.com 78475-443495


And similarly, any entry with text in e-mail address column, I want that whole info including Date, Names etc) to be copied onto the sheet Email database.

So I want it to look something like this:


Date Last Name First Name Email Mobile Number
02/1/2016 James Henry abx@yxz.com


And I want this to keep happening automatically in the other two sheets everytime I fill out a Master dabatase.

Can anyone help me please?! I really need help in this.

Thanks in advance!

 

[vcoolio]

Hello Aquaman,

The following code, placed in a standard module, should do the task for you:-

Sub FindStuff()

Application.ScreenUpdating = False

  Sheet1.Range("D1", Range("D" & Rows.Count).End(xlUp)).AutoFilter 1, "<>" & ""
     Range("A2", Range("E" & Rows.Count)).Copy Sheet3.Range("A" & Rows.Count).End(3)(2)
       [A1].AutoFilter

  Sheet1.Range("E1", Range("E" & Rows.Count).End(xlUp)).AutoFilter 1, "<>" & ""
     Range("A2", Range("E" & Rows.Count)).Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
       [A1].AutoFilter

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Anticipating that you have a large data set, I've written the code using the auto filter rather than a normal loop type code. This should speed things up somewhat.

Following is the link to my test work book for you to peruse. Click on the "RUN" button to see it work.

https://www.dropbox.com/s/oc3h3z468...mns and transfer to relevant sheet).xlsm?dl=0

I hope that this helps.

Cheerio,
vcoolio.

 

[vcoolio]

Hello Aquaman,

Your mail quota has been exceeded but as queries need to be solved on the forum and not by PM or e-mail, please upload your work book to a free file sharing site such as DropBox and then post the link to your file back here. Be careful with any sensitive data and preferably use dummy data. I'll then see how best to totally resolve your query.

Cheerio,
vcoolio.

 

[aquaman21]

Hi vcoolio,

Please find the link to download my dummy data file.

https://www.dropbox.com/s/h2tc696lz9rkn3u/Sorting from Master database.xlsx?dl=0

So basically any row with e-mail address filled, should be sorted into the E-mail Database sheet.

And any row with a phone number filled (i.e. not left blank), should be sorted into SMS Database sheet.

 

[vcoolio]

Hello Aquaman,

Following is the code amended to suit your work book:-

Sub FindStuff()

Application.ScreenUpdating = False

Sheet1.ListObjects("Table1").Unlist

  Sheet1.Range("E1", Range("E" & Rows.Count).End(xlUp)).AutoFilter 1, "<>" & ""
     [A1].CurrentRegion.Copy Sheet3.Range("A" & Rows.Count).End(3)
       [E1].AutoFilter

  Sheet1.Range("F1", Range("F" & Rows.Count).End(xlUp)).AutoFilter 1, "<>" & ""
     [A1].CurrentRegion.Copy Sheet2.Range("A" & Rows.Count).End(3)
       [F1].AutoFilter
       
Sheet2.Columns.AutoFit
Sheet3.Columns.AutoFit
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Place the code in a standard module and assign it to a button.

Following is the link to your work book with the code implemented:-

https://www.dropbox.com/s/2hxf40awvwknt7m/Aquaman21(2).xlsm?dl=0

Click on the "RUN" button to see it work.

I hope that this helps.

Cheerio,
vcoolio.

 

[aquaman21]

Hello Aquaman,

Following is the code amended to suit your work book:-

Sub FindStuff()

Application.ScreenUpdating = False

Sheet1.ListObjects("Table1").Unlist

  Sheet1.Range("E1", Range("E" & Rows.Count).End(xlUp)).AutoFilter 1, "<>" & ""
     [A1].CurrentRegion.Copy Sheet3.Range("A" & Rows.Count).End(3)
       [E1].AutoFilter

  Sheet1.Range("F1", Range("F" & Rows.Count).End(xlUp)).AutoFilter 1, "<>" & ""
     [A1].CurrentRegion.Copy Sheet2.Range("A" & Rows.Count).End(3)
       [F1].AutoFilter
       
Sheet2.Columns.AutoFit
Sheet3.Columns.AutoFit
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Place the code in a standard module and assign it to a button.

Following is the link to your work book with the code implemented:-

https://www.dropbox.com/s/2hxf40awvwknt7m/Aquaman21(2).xlsm?dl=0

Click on the "RUN" button to see it work.

I hope that this helps.

Cheerio,
vcoolio.

Thank you so much vcoolio. You're a God send. Just one more query:

If i increase the numbers of row in my original database, then how will I change the code? I tried increasing the number of rows so it says:

Runtime error 9
Subscript out of range

So is there any way to change this, and what if I want to keep updating my database, is there a code to automatically pick up the new rows whenever an update is made?

Thank you so so so much for your help! Really owe you one bro.

 

[vcoolio]

Hello Aquaman,

Apologies, I had to unlist the table to have the code execute correctly but neglected to put it back after the code executed which is why you have received the error message. So lets try again:-

Sub FindStuff()

Dim lr As Long
lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False

Sheet1.ListObjects("Table1").Unlist
Sheet2.UsedRange.ClearContents
Sheet3.UsedRange.ClearContents

  Sheet1.Range("E1", Range("E" & Rows.Count).End(xlUp)).AutoFilter 1, "<>" & ""
     [A1].CurrentRegion.Copy Sheet3.Range("A" & Rows.Count).End(3)
       [E1].AutoFilter

  Sheet1.Range("F1", Range("F" & Rows.Count).End(xlUp)).AutoFilter 1, "<>" & ""
     [A1].CurrentRegion.Copy Sheet2.Range("A" & Rows.Count).End(3)
       [F1].AutoFilter
       
Sheet1.[A1].AutoFilter
Sheet2.Columns.AutoFit
Sheet3.Columns.AutoFit
Sheet1.ListObjects.Add(xlSrcRange, Range("A1:F" & lr), , xlYes).Name = "Table1"
MsgBox "Data transfer completed.", vbExclamation

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

I've also assumed that you would like the filters to stay on in the sheet1 table.

Here's the link again, updated:-

https://www.dropbox.com/s/20p1t4lfjxw9nge/Aquaman21(2,table data).xlsm?dl=0

Cheerio,
vcoolio.

P.S.: Your table should work as per normal now so you can expand/decrease the data as needed and new entries will be accounted for.