1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Need help automatically moving Source Data from one tab to others

Discussion in 'VBA Macros' started by Dustin Hoffman, Feb 22, 2017.

  1. Dustin Hoffman

    Dustin Hoffman Member

    Messages:
    40
    Hello,

    This is my first time posting to a forum on this site but I have read tons of articles for help in the past. I have attached a sample document I am hoping to get a little help with. The "BoB" tab contains the source data that I am trying to automatically both label and copy over to the corresponding tab. I created a chart on the first tab "Reference Tab" that identifies the criteria needed to identify each row's eventual location. Each tab has already been build to list the source data in the middle of the page with the necessary subject lines (Each tab may have a different number of columns of data I need moved).

    Is it possible to help me build a Macro to do this automatically?

    Attached Files:

  2. PCosta87

    PCosta87 Well-Known Member

    Messages:
    820
    Hi and welcome to the forum ;)

    Please test the following:
    Code (vb):
    Sub copy()

        Dim c, c1 As Range
        Dim lrow, lrowdest, Col As Integer
       
        lrow = Sheets("BoB").Cells(Rows.Count, "A").End(xlUp).Row
       
        For Each c In Sheets("Reference Chart").Range("B4:B19")
            For Each c1 In Sheets("BoB").Range("F2:F" & lrow)
                If (c.Offset(, 2) = "RIC 1.2 MAY.09" Or c.Offset(, 2) = "RIC 1.2 DEC.11") And InStr(c1, c) > 0 And c1.Offset(, 2) >= c.Offset(, 3) And c1.Offset(, 2) <= c.Offset(, 4) Then
                    c1.Offset(, 4) = c.Offset(, 2)
                    Col = Sheets(c1.Offset(, 4).Value).Cells.Find(what:="Policy Number").Column
                    lrowdest = Sheets(c1.Offset(, 4).Value).Cells(Rows.Count, Col).End(xlUp).Offset(1).Row
                    Range(c1.Offset(, -5), c1.Offset(, 3)).copy Sheets(c1.Offset(, 4).Value).Cells(lrowdest, Col)
                ElseIf (c.Offset(, 2) = "No Rider Restrictions" Or c.Offset(, 2) = "02 Products or Older") And c <> "Blank" And InStr(c1, c) > 0 And c1.Offset(, 2) >= c.Offset(, 3) And c1.Offset(, 2) <= c.Offset(, 4) Then
                    c1.Offset(, 4) = c.Offset(, 2)
                    Col = Sheets(c1.Offset(, 4).Value).Cells.Find(what:="Policy Number").Column
                    lrowdest = Sheets(c1.Offset(, 4).Value).Cells(Rows.Count, Col).End(xlUp).Offset(1).Row
                    Range(c1.Offset(, -5), c1.Offset(, -1)).copy Sheets(c1.Offset(, 4).Value).Cells(lrowdest, Col)
                ElseIf (c.Offset(, 2) = "No Rider Restrictions" Or c.Offset(, 2) = "02 Products or Older") And c = "Blank" And c1 = "" And c1.Offset(, -3) >= c.Offset(, 3) And c1.Offset(, -3) <= c.Offset(, 4) Then
                    c1.Offset(, 4) = c.Offset(, 2)
                    Col = Sheets(c1.Offset(, 4).Value).Cells.Find(what:="Policy Number").Column
                    lrowdest = Sheets(c1.Offset(, 4).Value).Cells(Rows.Count, Col).End(xlUp).Offset(1).Row
                    Range(c1.Offset(, -5), c1.Offset(, -1)).copy Sheets(c1.Offset(, 4).Value).Cells(lrowdest, Col)
                ElseIf InStr(c1, c) > 0 And c1.Offset(, 2) >= c.Offset(, 3) And c1.Offset(, 2) <= c.Offset(, 4) Then
                    c1.Offset(, 4) = c.Offset(, 2)
                    Col = Sheets(c1.Offset(, 4).Value).Cells.Find(what:="Policy Number").Column
                    lrowdest = Sheets(c1.Offset(, 4).Value).Cells(Rows.Count, Col).End(xlUp).Offset(1).Row
                    Range(c1.Offset(, -5), c1.Offset(, 2)).copy Sheets(c1.Offset(, 4).Value).Cells(lrowdest, Col)
                End If
            Next c1
        Next c
                   
    End Sub
    Simply hit Alt+F8 and Enter... let me know if it is working as intended (file attached).

    Attached Files:

  3. Dustin Hoffman

    Dustin Hoffman Member

    Messages:
    40
    PCosta87,

    This is PERFECT! Thank you so much for this. I really can't thank you enough as this is a huge time saver. Is there a way for me to give you credit for this?
  4. PCosta87

    PCosta87 Well-Known Member

    Messages:
    820
    I believe you just did :)
    Glad I could help.
    Dustin Hoffman likes this.
  5. Dustin Hoffman

    Dustin Hoffman Member

    Messages:
    40
    PCosta87,

    I really hate to bug you again but I have a few additional questions:
    1. I made a mistake on the chart I provided. I've attached an updated chart with my changes highlighted that may simplify the code.
    2. The attached file also shows a new example I ran that appears to have missed the three bottom policies on the "BoB" tab. They should have been labeled and routed to the No Rider Restrictions tab. Did I do something wrong when I ran it since it appeared to have worked on the first example?
    3. I see you added 2/23/17 as an end date on the chart for a couple places that I had written "Current" as the end date; will the code recognize if a future date is listed there?
    4. Lastly, If I change the cells the source data needs moved to in the future by adding to the "Key" on each tab where can I find the appropriate code to change the location range?
    Again thank you so much and I really apriciat4e any help you're able to provide as this has already saved me a ton of time.

    Attached Files:

  6. PCosta87

    PCosta87 Well-Known Member

    Messages:
    820
    Hi,

    The only change I made was the reference range... "B4:B20" now, where it used to be "B4:B19". The rest seems to be working:
    Code (vb):
    Sub copy()

        Dim c, c1 As Range
        Dim lrow, lrowdest, Col As Integer

        lrow = Sheets("BoB").Cells(Rows.Count, "A").End(xlUp).Row

        For Each c In Sheets("Reference Chart").Range("B4:B20")
            For Each c1 In Sheets("BoB").Range("F2:F" & lrow)
                If (c.Offset(, 2) = "RIC 1.2 MAY.09" Or c.Offset(, 2) = "RIC 1.2 DEC.11") And InStr(c1, c) > 0 And c1.Offset(, 2) >= c.Offset(, 3) And c1.Offset(, 2) <= c.Offset(, 4) Then
                    c1.Offset(, 4) = c.Offset(, 2)
                    Col = Sheets(c1.Offset(, 4).Value).Cells.Find(what:="Policy Number").Column
                    lrowdest = Sheets(c1.Offset(, 4).Value).Cells(Rows.Count, Col).End(xlUp).Offset(1).Row
                    Range(c1.Offset(, -5), c1.Offset(, 3)).copy Sheets(c1.Offset(, 4).Value).Cells(lrowdest, Col)
                ElseIf (c.Offset(, 2) = "No Rider Restrictions" Or c.Offset(, 2) = "02 Products or Older") And c <> "Blank" And InStr(c1, c) > 0 And c1.Offset(, 2) >= c.Offset(, 3) And c1.Offset(, 2) <= c.Offset(, 4) Then
                    c1.Offset(, 4) = c.Offset(, 2)
                    Col = Sheets(c1.Offset(, 4).Value).Cells.Find(what:="Policy Number").Column
                    lrowdest = Sheets(c1.Offset(, 4).Value).Cells(Rows.Count, Col).End(xlUp).Offset(1).Row
                    Range(c1.Offset(, -5), c1.Offset(, -1)).copy Sheets(c1.Offset(, 4).Value).Cells(lrowdest, Col)
                ElseIf (c.Offset(, 2) = "No Rider Restrictions" Or c.Offset(, 2) = "02 Products or Older") And c = "Blank" And c1 = "" And c1.Offset(, -3) >= c.Offset(, 3) And c1.Offset(, -3) <= c.Offset(, 4) Then
                    c1.Offset(, 4) = c.Offset(, 2)
                    Col = Sheets(c1.Offset(, 4).Value).Cells.Find(what:="Policy Number").Column
                    lrowdest = Sheets(c1.Offset(, 4).Value).Cells(Rows.Count, Col).End(xlUp).Offset(1).Row
                    Range(c1.Offset(, -5), c1.Offset(, -1)).copy Sheets(c1.Offset(, 4).Value).Cells(lrowdest, Col)
                ElseIf InStr(c1, c) > 0 And c1.Offset(, 2) >= c.Offset(, 3) And c1.Offset(, 2) <= c.Offset(, 4) Then
                    c1.Offset(, 4) = c.Offset(, 2)
                    Col = Sheets(c1.Offset(, 4).Value).Cells.Find(what:="Policy Number").Column
                    lrowdest = Sheets(c1.Offset(, 4).Value).Cells(Rows.Count, Col).End(xlUp).Offset(1).Row
                    Range(c1.Offset(, -5), c1.Offset(, 2)).copy Sheets(c1.Offset(, 4).Value).Cells(lrowdest, Col)
                End If
            Next c1
        Next c
               
    End Sub
    The last 3 fall into the "Blank" Rider Type of the reference chart... those use the effective date, in column "C" of "BOB", instead of the "H" column. If you look closely, the dates are not correctly inserted in "C" (notice they are different from the dates in "H"). Excel isn't recognizing those dates so you need to enter them correctly:
    3/24/2015 --> 24-03-2015
    4/7/2014 ---> 07-04-2014
    8/23/2013 ---> 23-08-2013

    This is only for the "Blank" rider type... all other types are using the dates in "H" so the dates in "C" don't matter.

    It isn't actually 2/23/17... it is a function that returns today's date so it will always refer to "current": "=TODAY()"
    Since we are on this... What I did was have the subroutine compare the dates (either in "H" or in "C") with the "From" and "To" dates. Here I used 01-01-1900 for when you had no start date (I assumed you won't have data older than 1900 :)) and the mentioned "=TODAY()" function to return current date.
    Now, if for some reason, at some point, you have data with a date yet to come (let's say 2018 when the current date is still 2017) then it will be left out... however, you can always change that specific "To" date to whatever you want so it accommodates all the data you have, i.e. you can have 2019 or 2020 there if you want.

    I'm not sure I follow... can you elaborate? Thanks.

    Attached Files:

    Last edited: Feb 24, 2017
  7. Dustin Hoffman

    Dustin Hoffman Member

    Messages:
    40

    Attached Files:

  8. PCosta87

    PCosta87 Well-Known Member

    Messages:
    820
    Hi,

    You may want to fix the previous post as your comments are appearing as a quote and also inside the code :)
    In any case, I figured it out so I will be looking at that as soon as I can.
    Dustin Hoffman likes this.
  9. Dustin Hoffman

    Dustin Hoffman Member

    Messages:
    40
    Thank you so much! Not sure what I did there exactly.
  10. PCosta87

    PCosta87 Well-Known Member

    Messages:
    820
    Hi again,

    So, I fixed the duplicates problem by making sure each "sample" is only copied once...

    Now, since the code looks for the Rider Type (column "B" of the reference chart) in column "F" of "BOB", from top to bottom, we can take advantage of that.
    You see, RIC can be found in "BOB " where you have RIC 1.6... or RIC 1.2... but the opposite isn't true as RIC 1.6 will never match RIC only.
    That being said, and knowing excel is going from top to bottom on the reference chart, we just need to make sure the more complete "key" Rider types come first.

    Example:
    Let's imagine you get a situation similar to RIC in the future, say TRIP, TRIP 2017-1S, TRIP 2017-2S, TRIP 2017... the reference chart must have those from more "defined" to more "generic" (from top to bottom) as shown below:

    TRIP 2017-1S
    TRIP 2017-2S
    TRIP 2017
    TRIP

    This way when it looks for TRIP 2017, the others (TRIP 2017-1S & TRIP 2017-2S) which are above, are already out of the way. The same with TRIP.


    About future updates, you don't need to worry about changing the code... I updated it to make it dynamic.
    As long as you keep the column structure, you can add more rows to the reference chart as well as more data to BOB. The subroutine will automatically adjust the necessary ranges.

    I hope this is comprehensive enough and is working as intended.

    Please let me know if you come across some unexpected behavior or errors.

    Attached Files:

    Dustin Hoffman likes this.
  11. Dustin Hoffman

    Dustin Hoffman Member

    Messages:
    40
    Once again you have saved the day. This is all fantastic! I don't have any additional questions at this time. In the future I may have a few pipe dreams related to this report but you have provided more than I can thank you for at this point. Thank you :)
  12. Dustin Hoffman

    Dustin Hoffman Member

    Messages:
    40
    PCosta87,

    You may be getting sick of me at this point but I just have one thing that still does not appear to be working. The attached file shows some of the "No Rider Restrictions" rows not routing or labeling at all still. I thought it may be due to formatting but I'm not seeing that. Any ideas?

    Attached Files:

  13. PCosta87

    PCosta87 Well-Known Member

    Messages:
    820
    Hi,

    Sorry for the late response.

    It is the same as before... you need to re-enter the dates in column "C" for these that are empty in "F":
    6/19/2007 should be 19-06-2007 and so on.
    It is not just formatting, excel must recognize the content in "C" as a date... please refer to attached.

    Attached Files:

    Dustin Hoffman likes this.
  14. Dustin Hoffman

    Dustin Hoffman Member

    Messages:
    40
    Thank you sir! I also figured out the data was pulling in from my source a little different as you described and I was able to correct that using the "Text to Functions" feature as normal formatting was not working. I really appreciate all the help you provided on this.
  15. PCosta87

    PCosta87 Well-Known Member

    Messages:
    820
    Glad I could help ;)
    Dustin Hoffman likes this.
  16. Dustin Hoffman

    Dustin Hoffman Member

    Messages:
    40
    PCosta87,

    I added a TB (TIE) and it worked perfectly, however I also tried to add a couple more Rider Types to the chart but direct them over to the No Rider Restrictions Tab and it did not work. Any Ideas on that one?

    I attached the sample file that shows both example towards the bottom of the BoB tab.

    Attached Files:

  17. PCosta87

    PCosta87 Well-Known Member

    Messages:
    820
    Hi,

    The two samples that are not being copied over are "Taxpayer 2003" and "Taxpayer II".

    First things first, "Taxpayer II" won't work as the rider type should be "Taxpayer Plus II" or just "Taxpayer". "Taxpayer II" is not found anywhere on "BOB".

    Now, as requested, the subroutine compares the "From" and "To" dates of the reference chart to "C", only when "F" is empty which isn't the case in either of these two samples. For these, the dates must be in "H" otherwise nothing will be copied.

    So, after changing the reference chart to "Taxpayer Plus II" (instead of "Taxpayer II") and adding the dates to "H" in "BOB":
    Capturar.JPG
    Always keep in mind:
    For any sample with empty "F" dates must be in "C" otherwise they must be in "H".

    Let me know if you have any further questions.
  18. Dustin Hoffman

    Dustin Hoffman Member

    Messages:
    40
    Ok That makes sense. What I did not realize it when the source data pulls in it does not include a date for these types of Riders. Is there a way to have that look at "C" as well?
  19. PCosta87

    PCosta87 Well-Known Member

    Messages:
    820
    Hi,

    You can, but...
    Isn't it better to filter those who didn't get copied (after running the code) and move the date from "C" to "H"?
    Are you going to keep adding conditions to the code for each new Rider type that doesn't have a date in "H" and is not "Blank"?

    One other solution could be to have the code loop a second time and look at "C" for all samples that don't have a date in "H".

    Let me know what you think.
    Dustin Hoffman likes this.
  20. Dustin Hoffman

    Dustin Hoffman Member

    Messages:
    40
    Actually yes that would certainly work but in this case it could create inaccurate information as the "Rider Date" could be different from the "Effective Date".

    Your secondary option sounds like it would work perfect even for items that I might add in the future. The newest version I attached shows the correct name for this rider that will not pull back dates within the "Rider Date" Column". In theory these should be the only ones that ever work this way even in the future but you never know.

    You have truly been a saint throughout this process so thanks again for any help you are able to provide at your leisure. Please let me know if there is anything else I can do to thank you for this.

    Attached Files:

  21. PCosta87

    PCosta87 Well-Known Member

    Messages:
    820
    Hi,

    Test this one then... it will loop 2 times. First time it looks at "H" and then switches to "C" (I haven't tested it but it should work):
    Code (vb):
    Sub copy()

        Dim c, c1 As Range
        Dim lrow, lrowdest, lrowref, Col, i As Integer

        lrowref = Sheets("Reference Chart").Cells(Rows.Count, "B").End(xlUp).Row
        lrow = Sheets("BoB").Cells(Rows.Count, "A").End(xlUp).Row

        i = 2
        Do While i <> 0
            For Each c In Sheets("Reference Chart").Range("B4:B" & lrowref)
                For Each c1 In Sheets("BoB").Range("F2:F" & lrow)
                    If (c.Offset(, 2) = "RIC 1.2 MAY.09" Or c.Offset(, 2) = "RIC 1.2 DEC.11") And InStr(c1, c) > 0 And c1.Offset(, i) >= c.Offset(, 3) And c1.Offset(, i) <= c.Offset(, 4) And IsEmpty(c1.Offset(, 4)) = True Then
                        c1.Offset(, 4) = c.Offset(, 2)
                        Col = Sheets(c1.Offset(, 4).Value).Cells.Find(what:="Policy Number").Column
                        lrowdest = Sheets(c1.Offset(, 4).Value).Cells(Rows.Count, Col).End(xlUp).Offset(1).Row
                        Range(c1.Offset(, -5), c1.Offset(, 3)).copy Sheets(c1.Offset(, 4).Value).Cells(lrowdest, Col)
                    ElseIf (c.Offset(, 2) = "No Rider Restrictions" Or c.Offset(, 2) = "02 Products or Older") And c <> "Blank" And InStr(c1, c) > 0 And c1.Offset(, i) >= c.Offset(, 3) And c1.Offset(, i) <= c.Offset(, 4) And IsEmpty(c1.Offset(, 4)) = True Then
                        c1.Offset(, 4) = c.Offset(, 2)
                        Col = Sheets(c1.Offset(, 4).Value).Cells.Find(what:="Policy Number").Column
                        lrowdest = Sheets(c1.Offset(, 4).Value).Cells(Rows.Count, Col).End(xlUp).Offset(1).Row
                        Range(c1.Offset(, -5), c1.Offset(, -1)).copy Sheets(c1.Offset(, 4).Value).Cells(lrowdest, Col)
                    ElseIf (c.Offset(, 2) = "No Rider Restrictions" Or c.Offset(, 2) = "02 Products or Older") And c = "Blank" And c1 = "" And c1.Offset(, -3) >= c.Offset(, 3) And c1.Offset(, -3) <= c.Offset(, 4) And IsEmpty(c1.Offset(, 4)) = True Then
                        c1.Offset(, 4) = c.Offset(, 2)
                        Col = Sheets(c1.Offset(, 4).Value).Cells.Find(what:="Policy Number").Column
                        lrowdest = Sheets(c1.Offset(, 4).Value).Cells(Rows.Count, Col).End(xlUp).Offset(1).Row
                        Range(c1.Offset(, -5), c1.Offset(, -1)).copy Sheets(c1.Offset(, 4).Value).Cells(lrowdest, Col)
                    ElseIf InStr(c1, c) > 0 And c1.Offset(, i) >= c.Offset(, 3) And c1.Offset(, i) <= c.Offset(, 4) And IsEmpty(c1.Offset(, 4)) = True Then
                        c1.Offset(, 4) = c.Offset(, 2)
                        Col = Sheets(c1.Offset(, 4).Value).Cells.Find(what:="Policy Number").Column
                        lrowdest = Sheets(c1.Offset(, 4).Value).Cells(Rows.Count, Col).End(xlUp).Offset(1).Row
                        Range(c1.Offset(, -5), c1.Offset(, 2)).copy Sheets(c1.Offset(, 4).Value).Cells(lrowdest, Col)
                    End If
                Next c1
            Next c
            If i = -3 Then
                i = 0
            Else
                i = -3
            End If
        Loop
                     
    End Sub
    Last edited: Mar 7, 2017
  22. Dustin Hoffman

    Dustin Hoffman Member

    Messages:
    40
  23. Dustin Hoffman

    Dustin Hoffman Member

    Messages:
    40
    BINGO! This worked perfect! I am done bugging you but truly cannot thank you enough!
  24. PCosta87

    PCosta87 Well-Known Member

    Messages:
    820
    Great, I'm glad it is working!

    Feel free to ask any further questions... I will do my best to help ;)
    Dustin Hoffman likes this.
  25. Dustin Hoffman

    Dustin Hoffman Member

    Messages:
    40
    PCosta87,

    It's been a bit since you last helped and I have a few more questions on that same document. What you did previously was incredible and you were able to save me a ton of time so again I really can't thank you enough. I have some items written out below that I would love to have added to the current document that I have further enhanced but I need help updating the MACRO. I really apologize as this might be a lot but please let me know if there is anything I can do for you.

    List of things we want the Macro updated to do:

    Correction to an existing function. This was my error as my previous instructions did not include this:
    1. FIP and MAP should also look at Effective Date to drive policies to either “02 Products or Older” or “No Rider Restrictions”.
    New Steps to occur prior to the existing steps
    1. Before all the other items on the table, I need the MACRO needs to drive anything in the “Policy Number” field that starts with any letter or the number “7” to the “ML & Dreyfus” tab

    2. After the above step, we need anything in the policy number column that “contains” TAT, PSA, PS2, PS3, RB2 & RB3 should be driven to the “Misc” tab. If you’re able to do this can you show me how to add more policy number schemes in the future?

    3. Next, Anything with a letter as the third character in the “Policy Number” column should route to the “WRL” Tab. Or anything that “begins with” 09(then letter), 01(then Letter), 15(then Letter), 14(then Letter).

    4. Once the above three steps have run we can go back through and have the other steps run as originally laid out
    Additional Requests
    1. On the “BoB” tab I am hoping to add three columns. Is it possible to make the location of our columns dynamic on this page to allow them to land in a different location? If not this is not a huge deal I would just need to figure out how to add the three new columns in their current locations. (“Rebalance Running (Y/N)”, “Phone Authorization” and “DCA Running Y/N”). The addition of these obviously moved the location of “Available Funds Tab” column to M but nothing else we use was relocated.

    2. Is it possible to auto hide all tabs that no information is being driven to?

    3. Once info is driven to each page I manually go through and color code the policy number only when the policy number contains a policy scheme located in the key on that page. Is there a way to make this happen automatically? Everything else should remain white as there are no restrictions. The only other thing is on both RIC 1.2 tabs I highlight the policy number blue for any policies that have an “O” in the “Allocation method” column. This might be a lot but I’d love to get this automated as well.

    4. If step three is possible is it then possible to auto hide any columns and rows that do not apply(columns and rows that reference a policy scheme that is not listed)?

    5. I added a VLOOKUP in here using the “Rider Translator tab. This turns a code into an actual name that we use for the macro. Can we auto add that to the “Rider Type” Column allowing us to just paste several rows of date and have that translate automatically? I understand we will still have to go in and re paste over the top to change from a formula to values unless you have a better idea?
    Notes that may answer questions:
    • There is no key on the 02 Products or Older, ML and the Misc tabs. There were so many variations that I had to build it so you can just copy the applicable check boxes and paste them to the left of column C. Not sure this is the best strategy but I will likely have a few more to add to each.

    • You can ignore the red highlighted funds as I will eventually remove that

    Attached Files:

Share This Page