+ Reply to Thread
Results 1 to 16 of 16

Relatively simple problem (I hope)

  1. #1
    Registered User
    Join Date
    03-28-2006
    Posts
    9

    Smile Relatively simple problem (I hope)

    Hey guys. I apologize if this problem seems almost too simple to be posted but unfortunately I am working under tight deadlines and would like to tap into your expertise.

    All I'm trying to do is go down a column and every time my macro finds a non-empty cell, it will copy the cell's contents. The macro will then look below to the next cell, and if this next cell is blank, the macro will paste what was copied. It will then look below to the next cell and if it is blank, it will paste again, and so on. If however it finds another non-empty cell, it will copy the contents of that cell, and repeat this process until a designated row (such as row 1000 for example) is reached.

    Do you guys know how I could go about doing this? And is there a way to paste the copied data into the empty cells without 'referencing?' Meaning, for example, if I copy the contents of A1 into A2, if I then delete A1, I don't wish for A2 to give me any #REF errors.

    Thank you!

  2. #2
    Zack Barresse
    Guest

    Re: Relatively simple problem (I hope)

    Hello beboppin,

    Let me see if I understand this correctly. If I do, there is a very easy, 5
    second solution here. If not, it might take a bit longer.

    Let's say this is your data starting from A1 and going down to A7...

    Abc
    (blank)
    Def
    Ghi
    (blank)
    (blank)
    Jkl

    Would your cells be populated as such... ?

    Abc
    Abc
    Def
    Ghi
    Ghi
    Ghi
    Jkl

    ??

    --
    Regards,
    Zack Barresse, aka firefytr
    To email, remove NOSPAM



    "beboppin" <[email protected]> wrote in
    message news:[email protected]...
    >
    > Hey guys. I apologize if this problem seems almost too simple to be
    > posted but unfortunately I am working under tight deadlines and would
    > like to tap into your expertise.
    >
    > All I'm trying to do is go down a column and every time my macro finds
    > a non-empty cell, it will copy the cell's contents. The macro will then
    > look below to the next cell, and if this next cell is blank, the macro
    > will paste what was copied. It will then look below to the next cell
    > and if it is blank, it will paste again, and so on. If however it finds
    > another non-empty cell, it will copy the contents of that cell, and
    > repeat this process until a designated row (such as row 1000 for
    > example) is reached.
    >
    > Do you guys know how I could go about doing this? And is there a way to
    > paste the copied data into the empty cells without 'referencing?'
    > Meaning, for example, if I copy the contents of A1 into A2, if I then
    > delete A1, I don't wish for A2 to give me any #REF errors.
    >
    > Thank you!
    >
    >
    > --
    > beboppin
    > ------------------------------------------------------------------------
    > beboppin's Profile:
    > http://www.excelforum.com/member.php...o&userid=32917
    > View this thread: http://www.excelforum.com/showthread...hreadid=527377
    >




  3. #3
    Registered User
    Join Date
    03-28-2006
    Posts
    9

    Yes

    Yes, spot on. =]

  4. #4
    Norman Jones
    Guest

    Re: Relatively simple problem (I hope)

    Hi Bebobbin,

    Try:

    '=============>>
    Public Sub Tester011()
    Dim rng As Range, rng2 As Range

    Set rng = ActiveSheet.Range("A1:A1000") '<<==== CHANGE

    On Error Resume Next
    Set rng2 = rng.SpecialCells(xlBlanks)
    On Error GoTo 0

    If Not rng2 Is Nothing Then
    rng2.FormulaR1C1 = "=R[-1]C"
    End If

    End Sub
    '<<=============


    ---
    Regards,
    Norman



    "beboppin" <[email protected]> wrote in
    message news:[email protected]...
    >
    > Hey guys. I apologize if this problem seems almost too simple to be
    > posted but unfortunately I am working under tight deadlines and would
    > like to tap into your expertise.
    >
    > All I'm trying to do is go down a column and every time my macro finds
    > a non-empty cell, it will copy the cell's contents. The macro will then
    > look below to the next cell, and if this next cell is blank, the macro
    > will paste what was copied. It will then look below to the next cell
    > and if it is blank, it will paste again, and so on. If however it finds
    > another non-empty cell, it will copy the contents of that cell, and
    > repeat this process until a designated row (such as row 1000 for
    > example) is reached.
    >
    > Do you guys know how I could go about doing this? And is there a way to
    > paste the copied data into the empty cells without 'referencing?'
    > Meaning, for example, if I copy the contents of A1 into A2, if I then
    > delete A1, I don't wish for A2 to give me any #REF errors.
    >
    > Thank you!
    >
    >
    > --
    > beboppin
    > ------------------------------------------------------------------------
    > beboppin's Profile:
    > http://www.excelforum.com/member.php...o&userid=32917
    > View this thread: http://www.excelforum.com/showthread...hreadid=527377
    >




  5. #5
    Norman Jones
    Guest

    Re: Relatively simple problem (I hope)

    Hi Beboppin,

    Re-reading your question, try:

    '=============>>
    Public Sub Tester011A()
    Dim rng As Range, rng2 As Range

    Set rng = ActiveSheet.Range("A1:A1000") '<<==== CHANGE

    On Error Resume Next
    Set rng2 = rng.SpecialCells(xlBlanks)
    On Error GoTo 0

    If Not rng2 Is Nothing Then
    With rng2
    .Formula = "=R[-1]C"
    .Value = .Value
    End With
    End If

    End Sub
    '<<=============





    --
    ---
    Regards,
    Norman



    "Norman Jones" <[email protected]> wrote in message
    news:%23MB%[email protected]...
    > Hi Bebobbin,
    >
    > Try:
    >
    > '=============>>
    > Public Sub Tester011()
    > Dim rng As Range, rng2 As Range
    >
    > Set rng = ActiveSheet.Range("A1:A1000") '<<==== CHANGE
    >
    > On Error Resume Next
    > Set rng2 = rng.SpecialCells(xlBlanks)
    > On Error GoTo 0
    >
    > If Not rng2 Is Nothing Then
    > rng2.FormulaR1C1 = "=R[-1]C"
    > End If
    >
    > End Sub
    > '<<=============
    >
    >
    > ---
    > Regards,
    > Norman
    >
    >
    >
    > "beboppin" <[email protected]> wrote
    > in message news:[email protected]...
    >>
    >> Hey guys. I apologize if this problem seems almost too simple to be
    >> posted but unfortunately I am working under tight deadlines and would
    >> like to tap into your expertise.
    >>
    >> All I'm trying to do is go down a column and every time my macro finds
    >> a non-empty cell, it will copy the cell's contents. The macro will then
    >> look below to the next cell, and if this next cell is blank, the macro
    >> will paste what was copied. It will then look below to the next cell
    >> and if it is blank, it will paste again, and so on. If however it finds
    >> another non-empty cell, it will copy the contents of that cell, and
    >> repeat this process until a designated row (such as row 1000 for
    >> example) is reached.
    >>
    >> Do you guys know how I could go about doing this? And is there a way to
    >> paste the copied data into the empty cells without 'referencing?'
    >> Meaning, for example, if I copy the contents of A1 into A2, if I then
    >> delete A1, I don't wish for A2 to give me any #REF errors.
    >>
    >> Thank you!
    >>
    >>
    >> --
    >> beboppin
    >> ------------------------------------------------------------------------
    >> beboppin's Profile:
    >> http://www.excelforum.com/member.php...o&userid=32917
    >> View this thread:
    >> http://www.excelforum.com/showthread...hreadid=527377
    >>

    >
    >




  6. #6
    Zack Barresse
    Guest

    Re: Relatively simple problem (I hope)

    Okay, you can do this manually with no VBA required then. Do this...

    Select the range in question
    Press F5 | Special | Blank cells
    Hit your = sign, then press your Up arrow key
    Hit Ctrl + Enter
    Now copy your values
    Edit | Paste Special | Values

    HTH

    --
    Regards,
    Zack Barresse, aka firefytr
    To email, remove NOSPAM


    "beboppin" <[email protected]> wrote in
    message news:[email protected]...
    >
    > Yes, spot on. =]
    >
    >
    > --
    > beboppin
    > ------------------------------------------------------------------------
    > beboppin's Profile:
    > http://www.excelforum.com/member.php...o&userid=32917
    > View this thread: http://www.excelforum.com/showthread...hreadid=527377
    >




  7. #7
    Zack Barresse
    Guest

    Re: Relatively simple problem (I hope)

    Why not just use your keyboard shortcuts? It only takes me about 5-6
    seconds.. ??

    --
    Regards,
    Zack Barresse, aka firefytr
    To email, remove NOSPAM


    "Norman Jones" <[email protected]> wrote in message
    news:%23MB%[email protected]...
    > Hi Bebobbin,
    >
    > Try:
    >
    > '=============>>
    > Public Sub Tester011()
    > Dim rng As Range, rng2 As Range
    >
    > Set rng = ActiveSheet.Range("A1:A1000") '<<==== CHANGE
    >
    > On Error Resume Next
    > Set rng2 = rng.SpecialCells(xlBlanks)
    > On Error GoTo 0
    >
    > If Not rng2 Is Nothing Then
    > rng2.FormulaR1C1 = "=R[-1]C"
    > End If
    >
    > End Sub
    > '<<=============
    >
    >
    > ---
    > Regards,
    > Norman
    >
    >
    >
    > "beboppin" <[email protected]> wrote
    > in message news:[email protected]...
    >>
    >> Hey guys. I apologize if this problem seems almost too simple to be
    >> posted but unfortunately I am working under tight deadlines and would
    >> like to tap into your expertise.
    >>
    >> All I'm trying to do is go down a column and every time my macro finds
    >> a non-empty cell, it will copy the cell's contents. The macro will then
    >> look below to the next cell, and if this next cell is blank, the macro
    >> will paste what was copied. It will then look below to the next cell
    >> and if it is blank, it will paste again, and so on. If however it finds
    >> another non-empty cell, it will copy the contents of that cell, and
    >> repeat this process until a designated row (such as row 1000 for
    >> example) is reached.
    >>
    >> Do you guys know how I could go about doing this? And is there a way to
    >> paste the copied data into the empty cells without 'referencing?'
    >> Meaning, for example, if I copy the contents of A1 into A2, if I then
    >> delete A1, I don't wish for A2 to give me any #REF errors.
    >>
    >> Thank you!
    >>
    >>
    >> --
    >> beboppin
    >> ------------------------------------------------------------------------
    >> beboppin's Profile:
    >> http://www.excelforum.com/member.php...o&userid=32917
    >> View this thread:
    >> http://www.excelforum.com/showthread...hreadid=527377
    >>

    >
    >




  8. #8
    Norman Jones
    Guest

    Re: Relatively simple problem (I hope)

    Hi Zack,

    > Why not just use your keyboard shortcuts? It only takes me about 5-6
    > seconds.. ??


    Firstly, because this is a programming group and. secondly, because Beboppin
    specifically nominates a macro.


    ---
    Regards,
    Norman



    "Zack Barresse" <[email protected]> wrote in message
    news:[email protected]...
    > Why not just use your keyboard shortcuts? It only takes me about 5-6
    > seconds.. ??
    >
    > --
    > Regards,
    > Zack Barresse, aka firefytr
    > To email, remove NOSPAM
    >
    >
    > "Norman Jones" <[email protected]> wrote in message
    > news:%23MB%[email protected]...
    >> Hi Bebobbin,
    >>
    >> Try:
    >>
    >> '=============>>
    >> Public Sub Tester011()
    >> Dim rng As Range, rng2 As Range
    >>
    >> Set rng = ActiveSheet.Range("A1:A1000") '<<==== CHANGE
    >>
    >> On Error Resume Next
    >> Set rng2 = rng.SpecialCells(xlBlanks)
    >> On Error GoTo 0
    >>
    >> If Not rng2 Is Nothing Then
    >> rng2.FormulaR1C1 = "=R[-1]C"
    >> End If
    >>
    >> End Sub
    >> '<<=============
    >>
    >>
    >> ---
    >> Regards,
    >> Norman
    >>
    >>
    >>
    >> "beboppin" <[email protected]> wrote
    >> in message news:[email protected]...
    >>>
    >>> Hey guys. I apologize if this problem seems almost too simple to be
    >>> posted but unfortunately I am working under tight deadlines and would
    >>> like to tap into your expertise.
    >>>
    >>> All I'm trying to do is go down a column and every time my macro finds
    >>> a non-empty cell, it will copy the cell's contents. The macro will then
    >>> look below to the next cell, and if this next cell is blank, the macro
    >>> will paste what was copied. It will then look below to the next cell
    >>> and if it is blank, it will paste again, and so on. If however it finds
    >>> another non-empty cell, it will copy the contents of that cell, and
    >>> repeat this process until a designated row (such as row 1000 for
    >>> example) is reached.
    >>>
    >>> Do you guys know how I could go about doing this? And is there a way to
    >>> paste the copied data into the empty cells without 'referencing?'
    >>> Meaning, for example, if I copy the contents of A1 into A2, if I then
    >>> delete A1, I don't wish for A2 to give me any #REF errors.
    >>>
    >>> Thank you!
    >>>
    >>>
    >>> --
    >>> beboppin
    >>> ------------------------------------------------------------------------
    >>> beboppin's Profile:
    >>> http://www.excelforum.com/member.php...o&userid=32917
    >>> View this thread:
    >>> http://www.excelforum.com/showthread...hreadid=527377
    >>>

    >>
    >>

    >
    >




  9. #9
    Registered User
    Join Date
    03-28-2006
    Posts
    9

    Hey guys

    Thanks both for your help. Norm, the problem I'm having with the macro right now is that it pastes only the first value the macro encounters, so basically it is pasting Abc in all the blank slots. I'm guessing it's just a tiny tweak away from working. Zack, your method certainly worked, although I have no idea how either method works, but that's why you're the experts

    I have one more even simpler question. If I want to delete all rows that are completely blank in a certain range (like if there are 100 rows that contain no data within rows 1-1000), is there a simple way to do that?

    Thanks again guys for taking the time to help out an ignoramus like me

  10. #10
    Registered User
    Join Date
    03-28-2006
    Posts
    9

    Actually

    Don't worry about the last question. I think all my problems may be solved

    Thanks so much guys!

  11. #11
    Norman Jones
    Guest

    Re: Relatively simple problem (I hope)

    Hi Beboppin,

    > Norm, the problem I'm having with the macro
    > right now is that it pastes only the first value the macro encounters,
    > so basically it is pasting Abc in all the blank slots. I'm guessing
    > it's just a tiny tweak away from working


    Replace:

    >> .Value = .Value


    with

    rng.Value = rng.Value

    > I have one more even simpler question. If I want to delete all rows
    > that are completely blank in a certain range (like if there are 100
    > rows that contain no data within rows 1-1000), is there a simple way to
    > do that?
    >


    Try:

    '================>>
    Public Sub Tester()
    Dim WB As Workbook
    Dim SH As Worksheet
    Dim rng As Range
    Dim rCell As Range
    Dim delRng As Range
    Dim LRow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long

    Set WB = ActiveWorkbook '<<===== CHANGE
    Set SH = WB.Sheets("Sheet2") '<<===== CHANGE

    LRow = Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = SH.Range("A1:A" & LRow)

    On Error GoTo XIT

    With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    End With

    With ActiveWindow
    ViewMode = .View
    .View = xlNormalView
    End With

    SH.DisplayPageBreaks = False

    For Each rCell In rng.Cells
    If Application.CountA(rCell.EntireRow) = 0 Then
    If delRng Is Nothing Then
    Set delRng = rCell
    Else
    Set delRng = Union(rCell, delRng)
    End If
    End If
    Next rCell

    If Not delRng Is Nothing Then
    delRng.EntireRow.Delete
    End If

    XIT:
    With Application
    .Calculation = CalcMode
    .ScreenUpdating = True
    End With

    ActiveWindow.View = ViewMode

    End Sub
    '<<================


    ---
    Regards,
    Norman



    "beboppin" <[email protected]> wrote in
    message news:[email protected]...
    >
    > Thanks both for your help. Norm, the problem I'm having with the macro
    > right now is that it pastes only the first value the macro encounters,
    > so basically it is pasting Abc in all the blank slots. I'm guessing
    > it's just a tiny tweak away from working. Zack, your method certainly
    > worked, although I have no idea how either method works, but that's why
    > you're the experts
    >
    > I have one more even simpler question. If I want to delete all rows
    > that are completely blank in a certain range (like if there are 100
    > rows that contain no data within rows 1-1000), is there a simple way to
    > do that?
    >
    > Thanks again guys for taking the time to help out an ignoramus like me
    >
    >
    >
    > --
    > beboppin
    > ------------------------------------------------------------------------
    > beboppin's Profile:
    > http://www.excelforum.com/member.php...o&userid=32917
    > View this thread: http://www.excelforum.com/showthread...hreadid=527377
    >




  12. #12
    Norman Jones
    Guest

    Re: Relatively simple problem (I hope)

    To limit row deletion to a pspecific range, replace:

    > Set rng = SH.Range("A1:A" & LRow)


    with the required range, e.g.:

    Set rng = SH.Range("A1:A1000")

    If, however, the rows to be deleted may be defined by empty values in a
    specific column, say column A, then try:

    '=============>>
    Public Sub Tester()
    Dim rng As Range

    Set rng = ActiveSheet.Range("A1:A1000") '<<==== CHANGE

    On Error Resume Next
    rng.SpecialCells(xlBlanks).EntireRow.Delete
    On Error GoTo 0

    End Sub
    '<<=============


    ---
    Regards,
    Norman



  13. #13
    Zack Barresse
    Guest

    Re: Relatively simple problem (I hope)

    Ha! So you're saying that just because the OP asks for a macro and we're in
    a programming group that we should give a code solution rather than the
    right solution? Gotta disagree whole-heartedly with you there Norman. I
    know that many things can be accomplished with coding but not all solutions
    require VBA. If a native solution is there - and viable - we should opt to
    use it. We'll never match the speed or efficiency of a native solution.
    And regardless of where we are, the best solution should be offered. (IMHO)

    --
    Regards,
    Zack Barresse, aka firefytr
    To email, remove NOSPAM


    "Norman Jones" <[email protected]> wrote in message
    news:%[email protected]...
    > Hi Zack,
    >
    >> Why not just use your keyboard shortcuts? It only takes me about 5-6
    >> seconds.. ??

    >
    > Firstly, because this is a programming group and. secondly, because
    > Beboppin specifically nominates a macro.
    >
    >
    > ---
    > Regards,
    > Norman
    >
    >
    >
    > "Zack Barresse" <[email protected]> wrote in message
    > news:[email protected]...
    >> Why not just use your keyboard shortcuts? It only takes me about 5-6
    >> seconds.. ??
    >>
    >> --
    >> Regards,
    >> Zack Barresse, aka firefytr
    >> To email, remove NOSPAM
    >>
    >>
    >> "Norman Jones" <[email protected]> wrote in message
    >> news:%23MB%[email protected]...
    >>> Hi Bebobbin,
    >>>
    >>> Try:
    >>>
    >>> '=============>>
    >>> Public Sub Tester011()
    >>> Dim rng As Range, rng2 As Range
    >>>
    >>> Set rng = ActiveSheet.Range("A1:A1000") '<<==== CHANGE
    >>>
    >>> On Error Resume Next
    >>> Set rng2 = rng.SpecialCells(xlBlanks)
    >>> On Error GoTo 0
    >>>
    >>> If Not rng2 Is Nothing Then
    >>> rng2.FormulaR1C1 = "=R[-1]C"
    >>> End If
    >>>
    >>> End Sub
    >>> '<<=============
    >>>
    >>>
    >>> ---
    >>> Regards,
    >>> Norman
    >>>
    >>>
    >>>
    >>> "beboppin" <[email protected]> wrote
    >>> in message news:[email protected]...
    >>>>
    >>>> Hey guys. I apologize if this problem seems almost too simple to be
    >>>> posted but unfortunately I am working under tight deadlines and would
    >>>> like to tap into your expertise.
    >>>>
    >>>> All I'm trying to do is go down a column and every time my macro finds
    >>>> a non-empty cell, it will copy the cell's contents. The macro will then
    >>>> look below to the next cell, and if this next cell is blank, the macro
    >>>> will paste what was copied. It will then look below to the next cell
    >>>> and if it is blank, it will paste again, and so on. If however it finds
    >>>> another non-empty cell, it will copy the contents of that cell, and
    >>>> repeat this process until a designated row (such as row 1000 for
    >>>> example) is reached.
    >>>>
    >>>> Do you guys know how I could go about doing this? And is there a way to
    >>>> paste the copied data into the empty cells without 'referencing?'
    >>>> Meaning, for example, if I copy the contents of A1 into A2, if I then
    >>>> delete A1, I don't wish for A2 to give me any #REF errors.
    >>>>
    >>>> Thank you!
    >>>>
    >>>>
    >>>> --
    >>>> beboppin
    >>>> ------------------------------------------------------------------------
    >>>> beboppin's Profile:
    >>>> http://www.excelforum.com/member.php...o&userid=32917
    >>>> View this thread:
    >>>> http://www.excelforum.com/showthread...hreadid=527377
    >>>>
    >>>
    >>>

    >>
    >>

    >
    >




  14. #14
    Norman Jones
    Guest

    Re: Relatively simple problem (I hope)

    Hi Zack,

    Depending on the OP's requirements, a manual solution may not necessarily be
    appropriate.

    The fact that an operation can readily be performed manually does not
    preclude the possibility or, even, the potential desirability of a
    programmatic solution. It is eminently feasible, and indeed likely, that the
    requested code forms part of a substantially larger VBA application, which
    would militate against manual intervention at this juncture.

    It is certainly true that it is often desirable to draw a poster's attention
    to manual alternatives and, if you peruse my past responses, you will
    observe that I frequently do so.


    ---
    Regards,
    Norman



    "Zack Barresse" <[email protected]> wrote in message
    news:[email protected]...
    > Ha! So you're saying that just because the OP asks for a macro and we're
    > in a programming group that we should give a code solution rather than the
    > right solution? Gotta disagree whole-heartedly with you there Norman. I
    > know that many things can be accomplished with coding but not all
    > solutions require VBA. If a native solution is there - and viable - we
    > should opt to use it. We'll never match the speed or efficiency of a
    > native solution. And regardless of where we are, the best solution should
    > be offered. (IMHO)
    >
    > --
    > Regards,
    > Zack Barresse, aka firefytr
    > To email, remove NOSPAM
    >
    >
    > "Norman Jones" <[email protected]> wrote in message
    > news:%[email protected]...
    >> Hi Zack,
    >>
    >>> Why not just use your keyboard shortcuts? It only takes me about 5-6
    >>> seconds.. ??

    >>
    >> Firstly, because this is a programming group and. secondly, because
    >> Beboppin specifically nominates a macro.
    >>
    >>
    >> ---
    >> Regards,
    >> Norman
    >>
    >>
    >>
    >> "Zack Barresse" <[email protected]> wrote in message
    >> news:[email protected]...
    >>> Why not just use your keyboard shortcuts? It only takes me about 5-6
    >>> seconds.. ??
    >>>
    >>> --
    >>> Regards,
    >>> Zack Barresse, aka firefytr
    >>> To email, remove NOSPAM
    >>>




  15. #15
    Zack Barresse
    Guest

    Re: Relatively simple problem (I hope)

    Agreed on those points.

    --
    Regards,
    Zack Barresse, aka firefytr
    To email, remove NOSPAM


    "Norman Jones" <[email protected]> wrote in message
    news:%[email protected]...
    > Hi Zack,
    >
    > Depending on the OP's requirements, a manual solution may not necessarily
    > be appropriate.
    >
    > The fact that an operation can readily be performed manually does not
    > preclude the possibility or, even, the potential desirability of a
    > programmatic solution. It is eminently feasible, and indeed likely, that
    > the requested code forms part of a substantially larger VBA application,
    > which would militate against manual intervention at this juncture.
    >
    > It is certainly true that it is often desirable to draw a poster's
    > attention to manual alternatives and, if you peruse my past responses, you
    > will observe that I frequently do so.
    >
    >
    > ---
    > Regards,
    > Norman
    >
    >
    >
    > "Zack Barresse" <[email protected]> wrote in message
    > news:[email protected]...
    >> Ha! So you're saying that just because the OP asks for a macro and we're
    >> in a programming group that we should give a code solution rather than
    >> the right solution? Gotta disagree whole-heartedly with you there
    >> Norman. I know that many things can be accomplished with coding but not
    >> all solutions require VBA. If a native solution is there - and viable -
    >> we should opt to use it. We'll never match the speed or efficiency of a
    >> native solution. And regardless of where we are, the best solution should
    >> be offered. (IMHO)
    >>
    >> --
    >> Regards,
    >> Zack Barresse, aka firefytr
    >> To email, remove NOSPAM
    >>
    >>
    >> "Norman Jones" <[email protected]> wrote in message
    >> news:%[email protected]...
    >>> Hi Zack,
    >>>
    >>>> Why not just use your keyboard shortcuts? It only takes me about 5-6
    >>>> seconds.. ??
    >>>
    >>> Firstly, because this is a programming group and. secondly, because
    >>> Beboppin specifically nominates a macro.
    >>>
    >>>
    >>> ---
    >>> Regards,
    >>> Norman
    >>>
    >>>
    >>>
    >>> "Zack Barresse" <[email protected]> wrote in message
    >>> news:[email protected]...
    >>>> Why not just use your keyboard shortcuts? It only takes me about 5-6
    >>>> seconds.. ??
    >>>>
    >>>> --
    >>>> Regards,
    >>>> Zack Barresse, aka firefytr
    >>>> To email, remove NOSPAM
    >>>>

    >
    >




  16. #16
    Patricia Shannon
    Guest

    Re: Relatively simple problem (I hope)



    "Norman Jones" wrote:

    > Hi Zack,
    >
    > > Why not just use your keyboard shortcuts? It only takes me about 5-6
    > > seconds.. ??

    >
    > Firstly, because this is a programming group and. secondly, because Beboppin
    > specifically nominates a macro.
    >
    >
    > ---
    > Regards,
    > Norman
    >
    >
    >
    > "Zack Barresse" <[email protected]> wrote in message
    > news:[email protected]...
    > > Why not just use your keyboard shortcuts? It only takes me about 5-6
    > > seconds.. ??
    > >
    > > --
    > > Regards,
    > > Zack Barresse, aka firefytr
    > > To email, remove NOSPAM
    > >
    > >
    > > "Norman Jones" <[email protected]> wrote in message
    > > news:%23MB%[email protected]...
    > >> Hi Bebobbin,
    > >>
    > >> Try:
    > >>
    > >> '=============>>
    > >> Public Sub Tester011()
    > >> Dim rng As Range, rng2 As Range
    > >>
    > >> Set rng = ActiveSheet.Range("A1:A1000") '<<==== CHANGE
    > >>
    > >> On Error Resume Next
    > >> Set rng2 = rng.SpecialCells(xlBlanks)
    > >> On Error GoTo 0
    > >>
    > >> If Not rng2 Is Nothing Then
    > >> rng2.FormulaR1C1 = "=R[-1]C"
    > >> End If
    > >>
    > >> End Sub
    > >> '<<=============
    > >>
    > >>
    > >> ---
    > >> Regards,
    > >> Norman
    > >>
    > >>
    > >>
    > >> "beboppin" <[email protected]> wrote
    > >> in message news:[email protected]...
    > >>>
    > >>> Hey guys. I apologize if this problem seems almost too simple to be
    > >>> posted but unfortunately I am working under tight deadlines and would
    > >>> like to tap into your expertise.
    > >>>
    > >>> All I'm trying to do is go down a column and every time my macro finds
    > >>> a non-empty cell, it will copy the cell's contents. The macro will then
    > >>> look below to the next cell, and if this next cell is blank, the macro
    > >>> will paste what was copied. It will then look below to the next cell
    > >>> and if it is blank, it will paste again, and so on. If however it finds
    > >>> another non-empty cell, it will copy the contents of that cell, and
    > >>> repeat this process until a designated row (such as row 1000 for
    > >>> example) is reached.
    > >>>
    > >>> Do you guys know how I could go about doing this? And is there a way to
    > >>> paste the copied data into the empty cells without 'referencing?'
    > >>> Meaning, for example, if I copy the contents of A1 into A2, if I then
    > >>> delete A1, I don't wish for A2 to give me any #REF errors.
    > >>>
    > >>> Thank you!
    > >>>
    > >>>
    > >>> --
    > >>> beboppin
    > >>> ------------------------------------------------------------------------
    > >>> beboppin's Profile:
    > >>> http://www.excelforum.com/member.php...o&userid=32917
    > >>> View this thread:
    > >>> http://www.excelforum.com/showthread...hreadid=527377
    > >>>
    > >>
    > >>

    > >
    > >

    >
    >
    >


+ Reply to Thread

Thread Information

Users Browsing this Thread

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

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1