How to make ActiveCell.Range selection be an end down 1

[bac2u]

Hi,

I'm just trying to do a simple macro in Excel where I want to use Shift End Down to get to the next non-blank cell, and then do a copy function of that cell to the range of non-blank cells below it. The number of blank cells varies between the non-blank cells. Even though I use relative cell references it still records the number of cells between the non-blank cells. This means I can't just use a looping statement to repeat the macro all the way down 6,000 rows of data.

 

[Zathras]

This will do something like you want:

Sub ActiveCellEndDown()
  ActiveCell.End(xlDown).Select
End Sub

But, be aware that when using VBA to do stuff, it is usually better to use a technique that does not involve selecting cells the way one does manually.

For example, consider the following macro:

Sub ActiveCellEndDown2()
Dim r As Range
  Set r = ActiveCell
  While r.Row < 300
    Set r = r.End(xlDown)
    MsgBox r.Address
  Wend
  Set r = Nothing
End Sub

At any given point in the loop you can use r just the same as you would have used ActiveCell.

There are many possibilities. Hope this helps.

BTW, I see this is your first post. Welcome to Tek-Tips!

 

[bac2u]

Thank you for the suggestions. I'm still missing how to copy the contents of the non-blank cell to all the blank cells between it and the next non-blank cell. The ActiveCell.End(xldown) just copies it to the next non-blank field. What I need to do (in non-VBA terms) is anchor the copy at the cell and then select all the blank cells below it(using Shift End Down, then one up arrow), then do the copy. I know this is a really stupid question. I could do this in five minutes in lotus macros, which are less intelligent, but they just do what you tell 'em and don't argue!!

 

[Zathras]

Sorry about that. I kinda lost the original purpose for your post. Here is a macro that does what I think you want to do. Try it to see if it works for you.

Option Explicit
Sub FillBlankCells()

' Fills blank cells below currently selected cell

Dim r As Range
Dim rCopyTo As Range
Dim sFirstCell As String
Dim sLastCell As String
Dim sActiveCellAddress As String

  Application.ScreenUpdating = False
  sActiveCellAddress = ActiveCell.Address
  Set r = ActiveCell

  ' Find first gap following data

  If r.Text = "" Then

    ' We are in a hole - do 2 end downs

    Set r = r.End(xlDown)
    Set r = r.End(xlDown)
  End If
  While r.Row < 60000

    ' Remember address of first blank cell

    sFirstCell = r.Offset(1, 0).Address

    ' Copy the current cell and move to top of next block

    r.Copy
    Set r = r.End(xlDown)

    ' Get address of last blank cell and copy

    sLastCell = r.Offset(-1, 0).Address
    Set rCopyTo = Range(sFirstCell & ":" & sLastCell)

    ' Limit copy to currently used range

    Set rCopyTo = Intersect(rCopyTo, ActiveSheet.UsedRange)
    rCopyTo.PasteSpecial
    Application.CutCopyMode = False

    ' Move to bottom of current block (if not already there)

    If r.Row < 65536 Then
      If r.Offset(1, 0).Text <> &quot;&quot; Then
        Set r = r.End(xlDown)
      End If
    End If
  Wend
  Set r = Nothing
  Set rCopyTo = Nothing
  Application.ScreenUpdating = True
  Range(sActiveCellAddress).Select
End Sub

 

[bac2u]

Wow! THANK YOU!! I could have never figured this out in a million years. But now that I see what you're doing (sort of) I might be able to build some other macros using pieces of this one. Again, thanks!

 

[Zathras]

bac2u, You're welcome. The macro I posted is not the way to tackle the problem. I did it that way to show you that it could be solved using the end-down technique that works so well with a keyboard.

However as Zathras said "...this wrong tool. Never use this." (Babylon 5, Chapter Two. War Without End, Part One)

Here is a macro that does the same job and should be a little easier to understand:

Option Explicit

Sub FillBlankCells2()

' Fills blank cells below currently selected cell

Dim rCopyFrom As Range
Dim nLastUsedRow As Long
Dim nRow As Long

  ' Find last active row

  With ActiveSheet.UsedRange
   nLastUsedRow = .Rows.Count + .Row - 1
  End With

  ' Initialize "CopyFrom" range.

  Set rCopyFrom = Selection.Cells(1, 1)

  ' Process all cells in current column.

  For nRow = Selection.Row To nLastUsedRow
    If Cells(nRow, 1).Text = "" Then

      ' This cell is blank, copy from last non-blank cell.

      rCopyFrom.Copy Destination:=Cells(nRow, 1)
    Else

      ' This cell is not blank, use for next copy operation.

      Set rCopyFrom = Cells(nRow, 1)      
    End If
  Next nRow

  Set rCopyFrom = Nothing
End Sub

You see, with VBA you have more tools at your disposal and can usually build a macro that fits the shape of the problem. In this case just a simple for-next loop through the affected cells.

 

[bac2u]

Hi Zathras,

Yes, this one is definitely more intuitive. I'm still amazed at how much VBA programming knowledge one has to have to automate a simple task in Excel. This apparently can't be done with the macro recorder. So, there's a legion of us out here who could do stuff with Lotus macros and even Excel macros BVB (before VB) that we can't do now unless we're VB programmers. I hate that! This is Microsoft - take something simple and make it incomprensible. (Don't even get me going on Tabs in Word!!!)

 

[Zathras]

I understand completely. No sooner than you learn how to write macros for Lotus 1-2-3, the company switches to Excel. As soon as you learn how to write Excel 4 macros, Microsoft comes up with VBA.

But don't give up on the macro recorder. It is still the way to go when you have a complex task like pivot tables or graphics to set up. And I wouldn't call what you needed to do in the original post, a "simple task"

Oh, and I stay as far away from Word macros as I possibly can.