Group data based on Condition in excel vba

[coolkiran]

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.

 

[coolkiran]

Any suggestion would be great....

 

[p45cal]

try:

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

 

[p45cal]

Note that I've edited the code since first posting.

 

[coolkiran]

try:

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

Working perfectly. Thanks a lot.