Loading
Ozgrid Excel Help & Best Practices Forums

Excel Video Tutorials / Excel Dashboards Reports



Page 1 of 2 1 2 LastLast
Results 1 to 10 of 12

Thread: Split & Copy Groups/Segments Based On Cell Value In Column

  1. #1
    Join Date
    23rd April 2008
    Posts
    6

    Split & Copy Groups/Segments Based On Cell Value In Column

    Hi,

    This is my first post but I have been using Ozgrid for awhile now. I am farily good with excel formulas but have just started with macros so bear with me if i dont understand what you mean at first.

    I am looking for a way to copy rows our of sheet2 in the attached sheet based on the value in the segments column in sheet 2. The rows need to be paste into sheet3 (already has heading set up). The segments value is the number of times i need each row copied into the next sheet. The purpose of this is to split random length samples into 10cm incriments for study. For example, a 1.5m sample is taken so there should be 15 segments of 10cm each copied into sheet3.

    Also, if possible, it would be nice for it to display the actual length of the segment after copied into sheet3 for cases where the length was not evenly divisible by 10. I have found several examples of row copying macros, but none that will copy a conditional number of hte same row based on a cell value. In the original data there are close to 4000 rows, but the number of rows will vary depending on the data source.

    Another thought I had was if the total number of available rows is going to be exceded would it be possible to have the rows pasted into different sheets based on the rock type listed in the column?

    Thanks in advance for your help
    Attached Files. REMINDER! OzGrid accepts no responsibility for ANY adverse effects as a result from downloading attached files. ALWAYS run an up-to-date virus scan and disable macros.

    Excel Video Tutorials / Excel Dashboards Reports


  2. #2
    Join Date
    16th June 2005
    Location
    Dublin
    Posts
    4,537

    Re: Copy And Paste Conditional Number Of Row Based On Cell Value

    This will split the segments based on the value in Column U in sheet 2 and copy them into Sheet 3. I dont understand the other columns to the right of column S on sheet 3 (U,W,X,Y), so these are left blank.

    VB:
    Option Explicit 
     
    Public Sub split_segments() 
         
        Dim my_cell As Variant 
        Dim l_Loop As Long 
        Dim l_loop2 As Long 
         
        Application.Calculation = xlManual 
        Application.EnableEvents = False 
        Application.ScreenUpdating = False 
         
        Worksheets("Sheet3").Rows("7:" & Rows.Count).Delete 
         
        With Worksheets("Sheet2") 
            For l_Loop = 9 To .Range("B" & .Rows.Count).End(xlUp).Row 'start on row 9
                Worksheets("Sheet3").Range("B" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(.Range("U" & l_Loop), 18).Value = _ 
                .Range("B" & l_Loop & ":S" & l_Loop).Value 
            Next 
        End With 
         
        Application.Calculation = xlAutomatic 
        Application.EnableEvents = True 
        Application.ScreenUpdating = True 
         
    End Sub 
    
    
    A small note - it is probably wiser to WinZip... I think less people have access to WinRAR...

    Run Macro called "Split_Segments"

    Ger
    Attached Files. REMINDER! OzGrid accepts no responsibility for ANY adverse effects as a result from downloading attached files. ALWAYS run an up-to-date virus scan and disable macros.
    _______________________________________________
    There are 10 types of people in the world. Those that understand Binary and those that dont.

    Why are Halloween and Christmas the same? Because Oct 31 = Dec 25...

    The BEST Lookup function of all time

    Dynamic Named Ranges are your bestest friend

    _______________________________________________

  3. #3
    Join Date
    23rd April 2008
    Posts
    6

    Re: Copy And Paste Conditional Number Of Row Based On Cell Value

    Ger,
    Tha works well but when I put in all of the data I am getting a error message:
    Run-time error '1004':

    Application-defined or object-defined error

    Is it possible this error is because there is more data than rows?

    then it is highlighting
    VB:
    Worksheets("Sheet3").Range("B" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(.Range("U" & l_Loop), 18).Value = _ 
    .Range("B" & l_Loop & ":S" & l_Loop).Value 
    
    
    I was looking at the article on creating a worksheet for each item in a list and was thinking that could solve this problem, if it is the number of rows causing this error.

    Thanks

    Excel Video Tutorials / Excel Dashboards Reports


  4. #4
    Join Date
    16th June 2005
    Location
    Dublin
    Posts
    4,537

    Re: Copy And Paste Conditional Number Of Row Based On Cell Value

    Yes, thats certainly possible alright, in fact, if your data is following the same structure, you should be able to tell in advance if that IS the case. i.e. the segment numbers in COlumn U on Sheet 2 represent the number of times that that row will be copied. Therefore if you add all the numbers in Column U Row 9 to the bottom (use a simple sum formula at the end of the column), then this will indicate to you the number Rows that will be created in Sheet 3. If this sum is > 65536 then yes, you will have a problem creating blocks of segments the size of which is indicated in Column U. Additionally when the code crashes, it should have more or less filled Sheet 3 as requested... so if you scroll down to the last row of data on Sheet 3 and its close to row 65,000, then this too would indicate you have run out of Rows!

    You could create a new worksheet for each segment block, but that would probably be a pain and you are also likely to run out of worksheet space pretty quickly too...

    If you are on Excel 2007, the Row limitation shouldnt be a problem (over a million rows), but the worksheet would become unmanagable / unusable because you have several calls to a fairly complicated User Defined function in column S and R (if memory serves me right). That would slow down your worksheet.

    Depending on what exactly you want to do with the blocks of repeating data, you may be better off with a Pivot table... just a thought.

    Anyway, do me a favour and add up the numbers in Column U... it may not be a case that you have run out of Rows at all and it may well be the case that my code was just a pile of...

    Ger
    _______________________________________________
    There are 10 types of people in the world. Those that understand Binary and those that dont.

    Why are Halloween and Christmas the same? Because Oct 31 = Dec 25...

    The BEST Lookup function of all time

    Dynamic Named Ranges are your bestest friend

    _______________________________________________

  5. #5
    Join Date
    23rd April 2008
    Posts
    6

    Re: Copy And Paste Conditional Number Of Row Based On Cell Value

    Yeah,
    I double checked and sheet 3 was filled to about 5 rows from the bottom, i have 2007 at home, but not here so i have to keep it all in 2003 format . What we are doing is breaking all the random intervals down into 10cm blocks, then recompiling them into 10-20m increments by rock type. The reason that we go down to 10cm intervals is that we can justify throwing out 10cm intervals, but could not justify trashing a 1.5-3m interval.

    What I have been playing with is combining your macro with this

    VB:
    Sub PagesByDescription() 
        Dim rRange As Range, rCell As Range 
        Dim wSheet As Worksheet 
        Dim wSheetStart As Worksheet 
        Dim strText As String 
         
        Set wSheetStart = ActiveSheet 
        wSheetStart.AutoFilterMode = False 
         'Set a range variable to the correct item column
        Set rRange = Range("A1", Range("A65536").End(xlUp)) 
         
         'Delete any sheet called "UniqueList"
         'Turn off run time errors & delete alert
        On Error Resume Next 
        Application.DisplayAlerts = False 
        Worksheets("UniqueList").Delete 
         
         'Add a sheet called "UniqueList"
        Worksheets.Add().Name = "UniqueList" 
         
         'Filter the Set range so only a unique list is created
        With Worksheets("UniqueList") 
            rRange.AdvancedFilter xlFilterCopy, , _ 
            Worksheets("UniqueList").Range("A1"), True 
             
             'Set a range variable to the unique list, less the heading.
            Set rRange = .Range("A2", .Range("A65536").End(xlUp)) 
        End With 
         
        On Error Resume Next 
        With wSheetStart 
            For Each rCell In rRange 
                strText = rCell 
                .Range("A1").AutoFilter 1, strText 
                Worksheets(strText).Delete 
                 'Add a sheet named as content of rCell
                Worksheets.Add().Name = strText 
                 'Copy the visible filtered range _
                (default of Copy Method) And leave hidden rows 
                .UsedRange.Copy Destination:=ActiveSheet.Range("A1") 
                ActiveSheet.Cells.Columns.AutoFit 
            Next rCell 
        End With 
         
        With wSheetStart 
            .AutoFilterMode = False 
            .Activate 
        End With 
         
        On Error Goto 0 
        Application.DisplayAlerts = True 
    End Sub 
    
    
    from http://www.ozgrid.com/VBA/item-worksheets.htm

    and setting up a worksheet (or possibly a separate work book to keep the size down) for each rock type. Since ultimately we only look at rock types individually this would work well but I was not quite how to combine these two as it seems 2 different ways of pasting the data. I changed the headings around a bit in my sheet to get the code above to work in my sheet, and have been playing around (unsuccessfully) to get your code integrated. If you have any thoughts on this i would greatly appreciate it.

    Thanks
    Last edited by Gutray; May 7th, 2008 at 05:25. Reason: thought of something

    Excel Video Tutorials / Excel Dashboards Reports


  6. #6
    Join Date
    16th June 2005
    Location
    Dublin
    Posts
    4,537

    Re: Split & Copy Groups/Segments Based On Cell Value In Column

    Hi Gutray, I couldnt really adapt the code with certainty because you have changed the layout of your data...

    The code you provided above will create a new worksheet for a given unique value, but as I warned above somewhere you'll probably end up with a lot of worksheets...

    If you can get the code working that creates a new sheet for each unique item, post a sample of data and the working code and I'll see if I can figure out how to replicate each line 'x' number of times... but it would probably invovle adapting this piece of code here:

    VB:
    With wSheetStart 
        For Each rCell In rRange 
            strText = rCell 
            .Range("A1").AutoFilter 1, strText 
            Worksheets(strText).Delete 
             'Add a sheet named as content of rCell
            Worksheets.Add().Name = strText 
             'Copy the visible filtered range (default of Copy Method) And leave hidden rows
            .UsedRange.Copy Destination:=ActiveSheet.Range("A1") 
            [COLOR="Red"] 'create copies of the record on the activesheet
            ActiveSheet.Rows(1).Copy Destination:=ActiveSheet.Rows("2:10") 'for example - the 2:10 refers to the number of rows and that would need to be changed....[/COLOR]
            ActiveSheet.Cells.Columns.AutoFit 
        Next rCell 
    End With 
    
    
    Alternatively, you could split your data on Sheet 2 manually into 2 or 3 sheets to ensure you dont run over the 65536 limit and run my macro on each sheet...

    HTH
    Ger
    _______________________________________________
    There are 10 types of people in the world. Those that understand Binary and those that dont.

    Why are Halloween and Christmas the same? Because Oct 31 = Dec 25...

    The BEST Lookup function of all time

    Dynamic Named Ranges are your bestest friend

    _______________________________________________

  7. #7
    Join Date
    23rd April 2008
    Posts
    6

    Re: Split & Copy Groups/Segments Based On Cell Value In Column

    Ok, here is how i changed the data, I had to restructure the headings to get the advanced filter to work. The code to create the sheets is here:

    VB:
     'Create Sheets Named After Rock Rock Types
    Public Sub Strata() 
         
        Dim rRange As Range, rCell As Range 
        Dim wSheet As Worksheet 
        Dim wSheetStart As Worksheet 
        Dim strText As String 
         
        Set wSheetStart = ActiveSheet 
        wSheetStart.AutoFilterMode = False 
         'Set a range variable to the correct item column
        Set rRange = Range("A6", Range("A65536").End(xlUp)) 
         
         'Delete any sheet called "Strata"
         'Turn off run time errors & delete alert
        On Error Resume Next 
        Application.DisplayAlerts = False 
        Worksheets("Strata").Delete 
         
         'Add a sheet called "Strata"
        Worksheets.Add().Name = "Strata" 
         
         'Filter the Set range so only a unique list is created
        With Worksheets("Strata") 
            rRange.AdvancedFilter xlFilterCopy, , _ 
            Worksheets("Strata").Range("A1"), True 
             
             'Set a range variable to the unique list, less the heading.
            Set rRange = .Range("A2", .Range("A65536").End(xlUp)) 
        End With 
         
        On Error Resume Next 
        With wSheetStart 
            For Each rCell In rRange 
                strText = rCell 
                .Range("A6").AutoFilter 1, strText 
                Worksheets(strText).Delete 
                 'Add a sheet named as content of rCell
                Worksheets.Add().Name = strText 
                 
            Next rCell 
        End With 
         
        With wSheetStart 
            .AutoFilterMode = False 
            .Activate 
        End With 
         
        On Error Goto 0 
        Application.DisplayAlerts = True 
         
         
    End Sub 
    
    
    It will create the sheets but is not putting any data in the sheets as it sits now. Once all of this data goes into the other sheets there is a very large amount of calculations that come next, so i almost think it would be better to leave the sheets permanent, and have the code just rename them based on the unique list advanced filter creates on the "strata" sheet. That way the calculations and graphs will not have to be reconstructed or paste in.


    Thanks

    also, for some reason i can not get .zip files to compress smaller than .rar's this file is 42kb as a .rar and was 56kb as a .zip
    Auto Merged Post Until 24 Hrs Passes;

    Ger, do you think it would be possible to encorporate your code into the code above, since hte code above could copy each grouping into the seperate sheets, could your code copy the data the correct number of times overitself in the sheet?
    For instance, once all the basalt values were put into the basalt sheet, then your code copies each row the number of times specified, but places it over the data it copied instead of into a new sheet. If this is possible I think it would be the best bet
    Last edited by Gutray; May 7th, 2008 at 23:12. Reason: Fixed code slighty, changed a few "A1" to "A6"

    Excel Video Tutorials / Excel Dashboards Reports


  8. #8
    Join Date
    16th June 2005
    Location
    Dublin
    Posts
    4,537

    Re: Split & Copy Groups/Segments Based On Cell Value In Column

    This appears to work...

    You were setting the filter on the wrong row... your data started on Row 6, but you were filtering on Row 1....

    Additionally, you werent copying any data after the filtering. I also turned off screen updating and switched calulation to manual as the screen was flashing a little bit.

    Run the Macro called "Strata"

    VB:
    Option Explicit 
     
     'Create Sheets Named After Rock Rock Types
    Public Sub Strata() 
         
        Dim rRange As Range, rCell As Range 
        Dim wSheet As Worksheet 
        Dim wSheetStart As Worksheet 
        Dim strText As String 
        Dim lLoop As Long 
        Dim Num_Rows As Long 
        Application.ScreenUpdating = False 
        Application.Calculation = xlCalculationManual 
         
        Set wSheetStart = ActiveSheet 
        wSheetStart.AutoFilterMode = False 
         'Set a range variable to the correct item column
        Set rRange = Range("A1", Range("A65536").End(xlUp)) 
         
         'Delete any sheet called "Strata"
         'Turn off run time errors & delete alert
        On Error Resume Next 
        Application.DisplayAlerts = False 
        Worksheets("Strata").Delete 
         
         'Add a sheet called "Strata"
        Worksheets.Add().Name = "Strata" 
         
         'Filter the Set range so only a unique list is created
        With Worksheets("Strata") 
            rRange.AdvancedFilter xlFilterCopy, , _ 
            Worksheets("Strata").Range("A1"), True 
             
             'Set a range variable to the unique list, less the heading.
            Set rRange = .Range("A2", .Range("A65536").End(xlUp)) 
        End With 
         
        On Error Resume Next 
        With wSheetStart 
            For Each rCell In rRange 
                strText = rCell 
                .Range("A6").AutoFilter 1, strText 
                Worksheets(strText).Delete 
                 'Add a sheet named as content of rCell
                Worksheets.Add().Name = strText 
                .UsedRange.Copy Destination:=ActiveSheet.Range("A1") 
                With ActiveSheet 
                    Num_Rows = .Range("A" & .Rows.Count).End(xlUp).Row 
                    For lLoop = Num_Rows To 2 Step -1 'start on last row and work backwards to row 2
                        .Range("A" & lLoop).EntireRow.Copy 
                        .Rows(lLoop + 1 & ":" & lLoop + .Range("T" & lLoop).Value - 1).Insert shift:=xlDown 
                        Application.CutCopyMode = False 
                    Next 
                End With 
                 
            Next rCell 
        End With 
         
        With wSheetStart 
            .AutoFilterMode = False 
            .Activate 
        End With 
         
        On Error Goto 0 
        Application.DisplayAlerts = True 
        Application.ScreenUpdating = True 
        Application.Calculation = xlCalculationAutomatic 
         
    End Sub 
    
    
    HTH
    Ger
    Attached Files. REMINDER! OzGrid accepts no responsibility for ANY adverse effects as a result from downloading attached files. ALWAYS run an up-to-date virus scan and disable macros.
    _______________________________________________
    There are 10 types of people in the world. Those that understand Binary and those that dont.

    Why are Halloween and Christmas the same? Because Oct 31 = Dec 25...

    The BEST Lookup function of all time

    Dynamic Named Ranges are your bestest friend

    _______________________________________________

  9. #9
    Join Date
    23rd April 2008
    Posts
    6

    Re: Split & Copy Groups/Segments Based On Cell Value In Column

    Ger,

    That works perfectly. Thanks so much for the help!

    Excel Video Tutorials / Excel Dashboards Reports


  10. #10
    Join Date
    16th June 2005
    Location
    Dublin
    Posts
    4,537

    Re: Split & Copy Groups/Segments Based On Cell Value In Column

    Good, glad I was able to help...
    _______________________________________________
    There are 10 types of people in the world. Those that understand Binary and those that dont.

    Why are Halloween and Christmas the same? Because Oct 31 = Dec 25...

    The BEST Lookup function of all time

    Dynamic Named Ranges are your bestest friend

    _______________________________________________

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Possible Answers

  1. Replies: 6
    Last Post: March 19th, 2009, 11:24
  2. Create Worksheets Based On Data Groups In Column
    By shullmf in forum EXCEL HELP
    Replies: 2
    Last Post: April 10th, 2008, 02:59
  3. Split Data Into Multiple Worksheets Based On Column
    By Kostanzas200 in forum EXCEL HELP
    Replies: 4
    Last Post: February 4th, 2008, 12:31
  4. Replies: 2
    Last Post: January 17th, 2008, 11:47
  5. Copy Entire Column Based on Cell Value
    By koenraadvdc in forum EXCEL HELP
    Replies: 2
    Last Post: January 11th, 2006, 04:22

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
porno