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.

Group data based on Condition in excel vba

Discussion in 'VBA Macros' started by coolkiran, Oct 12, 2017 at 2:17 PM.

  1. coolkiran

    coolkiran Member

    Messages:
    108
    I have set of excel rows, which has 2 columns, first columns is date and second column is currency.

    So i want to split data based on below condition.

    Once Currency column is greater than zero, from that row till the row which has number greater than zero and copy entire row and paste it in seperate sheet.

    I have highlighted in color in input sheet, and also i have copied and pasted in output sheet.

    So from the attached file, i got 3 set of data, so it should create 3 sheets.

    Any suggesion would be great.

    Attached Files:

  2. coolkiran

    coolkiran Member

    Messages:
    108
    Any suggestion would be great....
  3. p45cal

    p45cal Well-Known Member

    Messages:
    822
    try:
    Code (vb):
    Sub blah()
    Dim StartRng As Range
    With Sheets("Input").Range("A1").CurrentRegion
      lr = .Row + .Rows.Count - 1  '(also = .Rows.Count)
     For Each rw In .Rows
        If IsDate(rw.Cells(1).Value) Then
          If rw.Cells(2).Value > 0 Or rw.Row >= lr Then
            If Not StartRng Is Nothing Then
              If rw.Row >= lr Then
                Set EndRng = rw.Cells(2)
              Else
                Set EndRng = rw.Cells(2).Offset(-1)
              End If
              Union(.Rows(1), Range(StartRng, EndRng)).Copy Sheets.Add(after:=Sheets(Sheets.Count)).Cells(1)
            End If
            Set StartRng = rw.Cells(1)
          End If
        End If
      Next rw
    End With
    End Sub
     
    Last edited: Oct 15, 2017 at 11:20 AM
    Thomas Kuriakose and coolkiran like this.
  4. p45cal

    p45cal Well-Known Member

    Messages:
    822
    Note that I've edited the code since first posting.
    coolkiran likes this.
  5. coolkiran

    coolkiran Member

    Messages:
    108
    Working perfectly. Thanks a lot.

Share This Page