Copy and paste withi selected range

[andytpl]

I have asked and have obtained the codes to copy and paste down a column based on a reference cell. The macro is able to skip blank cell and move to the next filled cell until the last cell. Xld has kindly provided the workable codes and they work fine.
I now wish to alter this codes so that instead of it will only works within a range I selected. That mean instead of the codes executing all the way down to the last reference cell it will only perform within the selected range. Below is the codes provided by Xld I like to know how to change it to suit the new requirement as described above. Thanks in advance

[vba]Public Sub copy_formula()

Dim LastRow As Long
Dim StartCell As Range
Dim rng As Range

Set StartCell = Application.InputBox("Select first cell of match range with the mouse", Type:=8)
If Not StartCell Is Nothing Then

With ActiveCell

LastRow = Cells(Rows.Count, StartCell.Column).End(xlUp).Row
.Offset(1, 0).Resize(LastRow - 1).ClearContents
Set rng = Cells(.Row + 1, StartCell.Column).Resize(LastRow).SpecialCells(xlCellTypeBlanks).Offset(0, .Column - StartCell.Column)
.Copy .Resize(LastRow)
rng.ClearContents
End With
End If

End Sub[/vba]

[Bob Phillips]

[vba]

Public Sub copy_formula()
Dim FirstRow As Long
Dim LastRow As Long
Dim NumRows As Long
Dim MatchRange As Range
Dim CopyFrom As Range
Dim DataRange As Range
Dim BlankRange As Range

Set CopyFrom = Application.InputBox("Select cell to copy from with the mouse", Type:=8)
Set MatchRange = Application.InputBox("Select ALL of match range with the mouse", Type:=8)
If Not CopyFrom Is Nothing And Not MatchRange Is Nothing Then

With CopyFrom

FirstRow = MatchRange.Row
LastRow = MatchRange(MatchRange.Count).Row
NumRows = LastRow - FirstRow + 1
Set DataRange = .Offset(FirstRow - 1, 0).Resize(NumRows)
DataRange.ClearContents
Set BlankRange = Cells(FirstRow - 1, MatchRange.Column).Resize(NumRows).SpecialCells(xlCellTypeBlanks).Offset(0, .Column - MatchRange.Column)
.Copy DataRange
BlankRange.ClearContents
End With
End If

End Sub
[/vba]

[andytpl]

Xld,

Thanks once again for your response. I encountered 2 problem when running this codes.
Firstly, if the formula is in row 1 I encountered a runtime error 1004.
Secondly, if the formula that I want to copy is in row 2 the above problem do not exist but another set of problem encountered. the range do not match up the the selected range. For example if I select to match A1 to A8 the corresponding result is D3 to D10.
I would suggest if possible just to have one input box which is to select the match range as the cell to be copied is the active cell.

[Bob Phillips]

Firstly, if the formula is in row 1 I encountered a runtime error 1004.

I don't see this problem. ALl of my testing has been with the formula to be copied in A1.

Secondly, if the formula that I want to copy is in row 2 the above problem do not exist but another set of problem encountered. the range do not match up the the selected range. For example if I select to match A1 to A8 the corresponding result is D3 to D10.

Not sure what you mean. Do you mean that A2 is the formula, and D310 is the range to match agaiants and the results end up in A1:A*, or the other way around.

I would suggest if possible just to have one input box which is to select the match range as the cell to be copied is the active cell.

That is not the problem. It works the same as the activecell, it is just in my testing I kept having another cell active, so it seemed wise to be explicit.

[andytpl]

The active cell with the formula to copy is in D1, the Range to reference is in Column A starting at A1 to A8.

[Bob Phillips]

So where does D3 to D10 come into play?

[andytpl]

So when I execute the macro the result instead of being at D1 to D8 it start at D3 to D10.

[Bob Phillips]

So we need to identify where the match range is (A1:A8), where the copy range starts at (D3)< and potentially where the formula is (D1)?

[andytpl]

Sorry, let me start all over again. In the first scenario if first input box selection is cell D1 I run into the error message and the formula in D1 disappear.
In the second scenario if the first input cell to be copied is cell D3 and match range is A3:A8 the copied starts at D611. Not too sure why?

[andytpl]

Xld,
Thanks for all the help, I managed to get the macro going through a friend. He has provided the below codes and it seem to works well.

[VBA]Sub Macro2()

Dim rngSelection, rngCell As Range
Dim strColActive As String
Dim lngRowFirst, lngRowLast As Long

strColActive = Mid(ActiveCell.Address, 2, _
(InStr(2, ActiveCell.Address, "$")) - 2)

On Error Resume Next
Application.DisplayAlerts = False
Set rngSelection = Application.InputBox(Prompt:= _
"Use your mouse to select the reference range.", _
Title:="SPECIFY RANGE", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True

If IsEmpty(rngSelection) = True Then
Exit Sub
Else
For Each rngCell In rngSelection
If lngRowFirst = 0 Then
lngRowFirst = rngCell.Row
End If
lngRowLast = rngCell.Row
Next rngCell
End If

Range(strColActive & lngRowFirst).Copy _
Range(strColActive & lngRowFirst + 1 & ":" & strColActive & lngRowLast)

For Each rngCell In Range(strColActive & lngRowFirst & ":" & strColActive & lngRowLast)
If rngCell.Value = 0 Then
rngCell.ClearContents
End If
Next rngCell

End Sub[/VBA]

[andytpl]

Xld,

For discussion sake, when I the following changes to your codes it will work fine if the cell to be copied starts from row 2 but encounter an error if it starts from row 1. Below is the codes with the changes in italics.

[vba]Public Sub copy_formula3()
Dim FirstRow As Long
Dim LastRow As Long
Dim NumRows As Long
Dim MatchRange As Range
Dim CopyFrom As Range
Dim DataRange As Range
Dim BlankRange As Range

Set CopyFrom = Application.InputBox("Select cell to copy from with the mouse", Type:=8)
Set MatchRange = Application.InputBox("Select ALL of match range with the mouse", Type:=8)
If Not CopyFrom Is Nothing And Not MatchRange Is Nothing Then

With CopyFrom

FirstRow = MatchRange.Row
LastRow = MatchRange(MatchRange.Count).Row
NumRows = LastRow - FirstRow
Set DataRange = .Offset(FirstRow - 1, 0).Resize(NumRows)
DataRange.ClearContents
Set BlankRange = Cells(FirstRow - 1, MatchRange.Column).Resize(NumRows).SpecialCells(xlCellTypeBlanks).Offset(0, .Column - MatchRange.Column)
.Copy DataRange
BlankRange.ClearContents
End With
End If

End Sub[/vba]

[Bob Phillips]

Sorry, I have lost the will to live on this one. I have lamentably failed to obtain a clear picture of what you are trying to change/match against, but you seem to have a solution, so I can move on.

[andytpl]

Sorry to hear that. My apology for not being clear with my request. Thanks for all that you have helped.