Automatically copy data from main sheet to child sheets. [Solved]

Posts
3
Registration date
Tuesday February 26, 2019
Status
Member
Last seen
February 28, 2019
-
Hello,

I know this question was asked in another thread (https://ccm.net/forum/affich-800808-need-to-automatically-copy-data-from-one-sheet-to-another), however, the thread was closed and I had additional questions...

I have a spreadsheet that I am updating for a coworker and trying to make it as automated as possible for minimal information typing but to gather complete statistics from.

The main tab "Customer List" tab contains an array of information regarding our customers (name, customer ID, demographics, products purchased, warranty expiration date, etc.). The Customer List tab is updated on a monthly basis and adds customer's whose warranties will be expiring within the next six months. I have a separate additional tab for each month of the year. I would like to be able to have the monthly tabs fill in automatically with the information in the Customer List tab as it is entered so my colleague only has to input the information once.

I found the above mentioned thread via Google and tried the "Example 1" VBA code posted by user vcoolio in the thread. I updated the the sheet names and corresponding information to match my worksheet, however, I am getting a "Run-time error '9': Subscript out of range" error; when selecting debug, it does not seem to highlight anything in the code either to point out what is wrong.

This would by my first time trying to use VBA, and I may not have a full grasp on how I can get this to work. Any help would be appreciated.

Thank you!

This is the version of the code I am trying to run in my Excel:

Sub TransferData()

Application.ScreenUpdating = False

Dim ws As Worksheet
Dim lrow As Long
Dim rng As Range
Set ws = Sheets("Expire")
lrow = ws.Cells(Rows.Count, 1).End(xlUp).Row

For Each rng In ws.Range("H2:H" & lrow)
Text = Right(rng.Value, 16)
Select Case Text
Case Is = 1
rng.EntireRow.Copy Sheets("Expire 01").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
rng.EntireRow.ClearContents
Case Is = 2
rng.EntireRow.Copy Sheets("Expire 02").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
rng.EntireRow.ClearContents
Case Is = 3
rng.EntireRow.Copy Sheets("Expire 03").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
rng.EntireRow.ClearContents
Case Is = 4
rng.EntireRow.Copy Sheets("Expire 04").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
rng.EntireRow.ClearContents
Case Is = 5
rng.EntireRow.Copy Sheets("Expire 05").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
rng.EntireRow.ClearContents
Case Is = 6
rng.EntireRow.Copy Sheets("Expire 06").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
rng.EntireRow.ClearContents
Case Is = 7
rng.EntireRow.Copy Sheets("Expire 07").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
rng.EntireRow.ClearContents
Case Is = 8
rng.EntireRow.Copy Sheets("Expire 08").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
rng.EntireRow.ClearContents
Case Is = 9
rng.EntireRow.Copy Sheets("Expire 09").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
rng.EntireRow.ClearContents
Case Is = 10
rng.EntireRow.Copy Sheets("Expire 010").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
rng.EntireRow.ClearContents
Case Is = 11
rng.EntireRow.Copy Sheets("Expire 011").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
rng.EntireRow.ClearContents
Case Is = 12
rng.EntireRow.Copy Sheets("Expire 12").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
rng.EntireRow.ClearContents

End Select

Next
MsgBox "Data transfer completed!", vbExclamation
Range("A1:P" & lrow).Sort key1:=Range("H1:H" & lrow), order1:=xlAscending, Header:=xlYes
Application.ScreenUpdating = True

End Sub
See more 

Your reply

2 replies

Posts
1236
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
March 1, 2019
220
0
Thank you
Hello Fenrir,

That error generally means that a sheet doesn't exist or can't be found (due to things such as incorrect spelling, additional spaces etc.).
For example, in your code above, this line:-

Text = Right(rng.Value, 16) 


suggests that you are trying to find/extract sixteen characters from the right hand side of a cell value to use as criteria.The question here is: Is there sixteen characters that you need to find?

For us to endeavour to help you, it would be a good idea for you to upload a sample of your workbook to a free file sharing site (such as GE.TT or Drop Box) and then post the link to your sample file back here.
Make sure that the sample is an exact replica of your actual workbook and if your data is sensitive then please use dummy data.

Cheerio,
vcoolio.
Fenrir91_9
Posts
3
Registration date
Tuesday February 26, 2019
Status
Member
Last seen
February 28, 2019
-
Hi Vcoolio,

Thank you so much for your response!

I see my first error would certainly mess up the code. For the range, I was thinking that the "16" number would be telling the code how many columns over it can search for data, so I tried to give it a large range to search.

Here is a link to a dummy copy of the file on Dropbox.

https://www.dropbox.com/s/ieqka4l32srojrc/Expiring%20Warranty.xlsx?dl=0

I was hoping to get Excel to automatically copy the entire row of data into the corresponding monthly tab of when the warranty is expiring; for example, if the data of the customer on row 2 was just pasted into the excel then the entire row would be copied into the "Expire 09" tab based on the date in column G.

If the entire row is not possible to have it automatically copy, I can make do with just column B copying over and then I can set a Vlookup for the rest of the information from there.

Thank you again for your help!
Respond to vcoolio
Posts
1236
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
March 1, 2019
220
0
Thank you
Hello Fenrir,

Following is a code that should do the task for you:-

Sub CreateNewShtsTransferData()

        Dim sht As Worksheet, ws As Worksheet
        Dim lr As Long, x As Long
        Dim ID As Object
        Dim key As Variant

        Set sht = Sheet1
        Set ID = CreateObject("Scripting.Dictionary")
        
Application.ScreenUpdating = False
     
        lr = sht.Range("A" & Rows.Count).End(xlUp).Row
        sht.Range("P2:P" & lr) = "=""Expiry"" & "" "" & TEXT(G2,""mm"")"
        sht.Range("A2:P" & lr).Sort sht.[P2], 1

For x = 2 To lr
        If Not ID.Exists(sht.Range("P" & x).Value) Then
        ID.Add sht.Range("P" & x).Value, 1
        End If
Next x

For Each key In ID.keys
        If Not Evaluate("ISREF('" & key & "'!A1)") Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = key
        End If
        
        Set ws = Sheets(key)
        ws.UsedRange.Clear
        sht.Range("P1:P" & lr).AutoFilter 1, key
        sht.[A1].CurrentRegion.Copy ws.[A1]
        ws.Columns.AutoFit
        sht.[P1].AutoFilter
Next key

sht.Select
sht.Columns(16).Clear

Application.ScreenUpdating = True

MsgBox "All done!", vbExclamation

End Sub


To further automate the whole process and, in effect, simplify it a little, I've actually taken this one step further for you.

The code actually creates the required worksheets for you as needed and transfers the relevant data to the relevant sheet.
The code places a formula in a helper column (Column P) which extracts the month from Column G and adds "Expire" in front of the relevant month (e.g. Expire 06) which thus creates your sheet names (as per your sample). Line 15 in the code above shows the formula that is used.
Hence, as you add new dates with differing months, new sheets will be added as required without duplication. The data in each sheet is refreshed each time the code is executed.
To further streamline the code and speed it up even more, the data in the "Customer List" sheet is sorted via Column P also.
Column P is always cleared and is only used for an instant as the helper.

Following is the link to your sample file with the code implemented:-

http://ge.tt/9hyzFju2

Click on the "RUN" button to see it work. You'll note that there aren't any individual month sheets when you open the file. These will be created on executing the code. Play around with the data in the Customer List sheet (add/delete) then click on the button again to see how each sheet is added/refreshed.

Hence, in your actual workbook, delete the existing month sheets and save the file without them. Just keep the Customer List and Data Summary sheets.

However, make sure that you test the code in a copy of your actual workbook first to satisfy yourself that all this works for you.

I hope that this helps.

Cheerio,
vcoolio.
Fenrir91_9
Posts
3
Registration date
Tuesday February 26, 2019
Status
Member
Last seen
February 28, 2019
-
Hi Vcoolio,

Wow! Thank you so much! That is amazing and works perfectly! Can't thank you enough for your help! :)
vcoolio
Posts
1236
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
March 1, 2019
220 -
You're welcome Fenrir. I'm glad to have been able to assist you.
Good luck with it all!

Cheerio,
vcoolio.
Respond to vcoolio