[RESOLVED] Copy cell range until cell contains zero-VBForums
Results 1 to 11 of 11

Thread: [RESOLVED] Copy cell range until cell contains zero

  1. #1

    Thread Starter
    Junior Member
    Join Date
    Nov 2013
    Posts
    22

    Resolved [RESOLVED] Copy cell range until cell contains zero

    Hi:

    I need a macro to copy a range of cells starting in FT2:FX2
    Checkin in col FT for a blank cell or Col FU for a zero (0) signaling the end of the data range.

    I then need to select this range of cells and sort them by date col FT in descending order (Z to A).

    Last, I need to copy these cells into a new range starting in cell FY2.

    I know how to do all of this except check for the end of data flag?

    Thanks for any suggestions / assistance,

    Michael
    Last edited by MSlattery; Jan 9th, 2014 at 11:59 PM.

  2. #2
    PowerPoster
    Join Date
    Dec 2004
    Posts
    23,034

    Re: Copy cell range until cell contains zero

    to return the last column index with data, try like
    Code:
    for each cel in range("ft2:fx2")
      if isempty(cel) or cel = 0 then lastcol = cel.column - 1: exit for
    next
    you can then use the last column index for your range
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  3. #3

    Thread Starter
    Junior Member
    Join Date
    Nov 2013
    Posts
    22

    Re: Copy cell range until cell contains zero

    Hello Pete:

    Thanks for your assistance. I understand your code, but not exactly sure how to integrate it within my macro?

    Code:
    Sub ZigZagReSort2End()
    '
    ' ZigZagReSort2End Macro
    
        For Each cel In Range("ft2:fx2")
      If IsEmpty(cel) Or cel = 0 Then lastcol = cel.Column - 1: Exit For
    Next
    Range("FT2:FX201").Select
        ActiveWorkbook.Worksheets("F").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("F").Sort.SortFields.Add Key:=Range("FT3:FT201"), _
            SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("F").Sort
            .SetRange Range("FT2:FX201")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
       
    End Sub
    Is there a way to replace the . Range("FT2:FX201"), to the new range, defined by your code?
    There may be a much simpler way that I am not aware of just as I expected a nested IF statement in order to be able to detect the last cell?

    I also just noticed that the active worksheet is being addressed by the tab name which is also the current stock ticker being analyzed. What generic name do I replace that ("F") with so that when I change the ticker symbol in the tab, all of my macros still work?

    Thanks Michael
    Last edited by MSlattery; Jan 10th, 2014 at 11:07 AM.

  4. #4
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,423

    Re: Copy cell range until cell contains zero

    Michael,

    Does your data start in FT2 and go across to FX2, and down for a variable number of rows? So, for example, the data continues downward until row 99 where we find either a blank in FT99 or a zero in FU99?

  5. #5

    Thread Starter
    Junior Member
    Join Date
    Nov 2013
    Posts
    22

    Re: Copy cell range until cell contains zero

    Quote Originally Posted by vbfbryce View Post
    Michael,

    Does your data start in FT2 and go across to FX2, and down for a variable number of rows? So, for example, the data continues downward until row 99 where we find either a blank in FT99 or a zero in FU99?
    Yes, actually after it is sorted the first time it is possible for there to be as many as 200 rows of data. The Col range is indeed FT through FX.

    I just need to "Select" all the rows up to, but not including the first blank or zero so that the next sort rang is defined. This will segregate only my target data for the next step.

    Thanks, Michael

  6. #6
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,423

    Re: Copy cell range until cell contains zero

    Ok, so maybe something like this to find the last row of the data (assumes that the BLANK in FT and the ZERO in FU don't necessarily happen in the same row, but that could be wrong):

    Code:
    Sub findBottom()
        Dim ws As Worksheet
        Dim firstBlankRow As Long
        Dim firstZeroRow As Long
        Dim lastRow As Long
        Dim i As Long
        
        Set ws = ActiveSheet
        firstBlankRow = ws.Range("ft2").End(xlDown).Row + 1
        If firstBlankRow - 1 = ws.Rows.Count Then
            firstBlankRow = 1
            Exit Sub
        End If
        For i = 2 To firstBlankRow - 1
            If ws.Range("fu" & i).Value = 0 Then
                firstZeroRow = i
                Exit For
            End If
        Next i
        If Application.WorksheetFunction.Min(firstBlankRow, firstZeroRow) = 0 Then
            lastRow = Application.WorksheetFunction.Max(firstBlankRow, firstZeroRow) - 1
        Else
            lastRow = Application.WorksheetFunction.Min(firstBlankRow, firstZeroRow) - 1
        End If
    End Sub

  7. #7

    Thread Starter
    Junior Member
    Join Date
    Nov 2013
    Posts
    22

    Re: Copy cell range until cell contains zero

    Thanks FM:

    How do I extract the sort range from you Sub?

    Is the answer to my sectioned question "ActiveSheet"? to produce a generic reference that will ignore the actual name of the sheet?

    Thanks, Michael

  8. #8
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,423

    Re: Copy cell range until cell contains zero

    You incorporate "lastRow" into the code. Tack something like this onto the end of the previous code (before the End Sub):

    Code:
    Dim rngKey As Range
        Dim rngSort As Range
        
        Set rngSort = ws.Range("FT1:FX" & lastRow)
        Set rngKey = ws.Range("FT2:FT" & lastRow)
        
        With ws.Sort
            .SortFields Clear
            .SortFields.Add Key:=rngKey, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            .SetRange rngSort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

  9. #9

    Thread Starter
    Junior Member
    Join Date
    Nov 2013
    Posts
    22

    Re: Copy cell range until cell contains zero

    Thanks Vbfbryce:

    Below is the combined code. On first run I got the following error code: Compile Error: Invalid Use of Property

    With the following row/text highlighted: "SortFields" and then unhighlighted the word "Clear."

    I though that this indicated "SortFields" needed to be defined with DIM so I tried that. Still not working.

    Thanks, Michael

    Code:
    Sub findBottomWithSort2()
        Dim ws As Worksheet
        Dim firstBlankRow As Long
        Dim firstZeroRow As Long
        Dim lastRow As Long
        Dim i As Long
        Dim SortFields As Areas
        Set ws = ActiveSheet
        firstBlankRow = ws.Range("ft2").End(xlDown).Row + 1
        If firstBlankRow - 1 = ws.Rows.Count Then
            firstBlankRow = 1
            Exit Sub
        End If
        For i = 2 To firstBlankRow - 1
            If ws.Range("fu" & i).Value = 0 Then
                firstZeroRow = i
                Exit For
            End If
        Next i
        If Application.WorksheetFunction.Min(firstBlankRow, firstZeroRow) = 0 Then
            lastRow = Application.WorksheetFunction.Max(firstBlankRow, firstZeroRow) - 1
        Else
            lastRow = Application.WorksheetFunction.Min(firstBlankRow, firstZeroRow) - 1
        End If
        Dim rngKey As Range
        Dim rngSort As Range
        
        Set rngSort = ws.Range("FT1:FX" & lastRow)
        Set rngKey = ws.Range("FT2:FT" & lastRow)
        
        With ws.Sort
            .SortFields Clear
            .SortFields.Add Key:=rngKey, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            .SetRange rngSort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

  10. #10
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,423

    Re: Copy cell range until cell contains zero

    sorry, was supposed to have been ".SortFields.Clear" with the period, not a space in there.

  11. #11

    Thread Starter
    Junior Member
    Join Date
    Nov 2013
    Posts
    22

    Re: Copy cell range until cell contains zero

    That worked like a dream, thanks to all for you very professional assistance,

    Michael

Tags for this Thread

Posting Permissions

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



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.