Automatically copy data from main sheet to child sheets. Solved/Closed

Question

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

vcoolio · Answer

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.

vcoolio · Answer

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.

Automatically copy data from main sheet to child sheets.

2 responses

Similar discussions

Subscribe To Our Newsletter!