Announcement

Collapse
No announcement yet.

Unconfigured Ad Widget

Collapse

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

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • 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

  • #2
    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.

    Code:
    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

    Check out our new reputation system. Click on the "star" under the post!
    _______________________________________________

    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

    _______________________________________________

    Comment


    • #3
      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
      Code:
      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

      Comment


      • #4
        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

        Check out our new reputation system. Click on the "star" under the post!
        _______________________________________________

        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

        _______________________________________________

        Comment


        • #5
          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

          Code:
          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, 05:25. Reason: thought of something

          Comment


          • #6
            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:

            Code:
            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") 
            '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....
                        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

            Check out our new reputation system. Click on the "star" under the post!
            _______________________________________________

            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

            _______________________________________________

            Comment


            • #7
              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:

              Code:
              '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
              Attached Files
              Last edited by Gutray; May 7th, 2008, 23:12. Reason: Fixed code slighty, changed a few "A1" to "A6"

              Comment


              • #8
                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"

                Code:
                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

                Check out our new reputation system. Click on the "star" under the post!
                _______________________________________________

                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

                _______________________________________________

                Comment


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

                  Ger,

                  That works perfectly. Thanks so much for the help!

                  Comment


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

                    Good, glad I was able to help...

                    Check out our new reputation system. Click on the "star" under the post!
                    _______________________________________________

                    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

                    _______________________________________________

                    Comment


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

                      Ger,

                      After ive been playing around with the data I have found a few cases where it is not copying the row multiple times when its indicated it should have. Right now I am figuring this is because of the raw amount of data. I cant find any other reason that it is not working since 98% of the time it does it perfectly. If you have any thoughts let me know. Once again thanks for getting that macro working, it is an emmense help.

                      Comment


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

                        Hi Gutray, honestly, I have no idea... the only thing that MIGHT be happening is the numbers in Column T (which defines the number of times a row should be copied), may not be a number, or an invalid number, or defined as text or something like that... but doesnt make a whole lot of sense....

                        Can you isolate a specific repeatable instance where it does not work.... if so, post the actual subset of the data and I'll try and resolve it for you.

                        Ger

                        Check out our new reputation system. Click on the "star" under the post!
                        _______________________________________________

                        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

                        _______________________________________________

                        Comment

                        Trending

                        Collapse

                        There are no results that meet this criteria.

                        Working...
                        X