Automated cell copy depending on cell content?

  • Thread starter Thread starter Joachim Fabini
  • Start date Start date
J

Joachim Fabini

Hi,

Specifically, I'm looking for a macro that does the following:

For a selected column
For any cell in this column
if (the current cell is not empty) and
(the cell above the current cell is empty) and
(the cell below the current cell is empty)
then
copy the content of the current cell into the cell below
(alternatively, into the cell at the right).

The column A below should become column B after applying the macro.

Col. A Col.B
<empty> <empty>
<empty> <empty>
one one
<empty> one
<empty> <empty>
<empty> <empty>
two <two>
three <three>
<empty> <empty>
<empty> <empty>
four <four>
<empty> <four>

This should be pretty straight-forward but I am totally unaware of the
VB syntax. Thanks in advance,

Best regards
--Joachim
 
for i = cells(rows.count,1).End(xlup).row+1, to 2 step -1
if not isempty(cells(i,1)) and isempty(cells(i+1)) and
isempty(cells(i-1,1) then
cells(i+1,1).Value = cells(i,1).Value
end if
Next

Regards,
Tom Ogilvy
 
=IF(AND(A2<>"",A1="",A3=""),A2,A3)

Put this in all cells in column B

but put a blank row at the top. I guess you could be
clever and juggle about with the first row but best to
keep it simple.
 
for i = cells(rows.count,1).End(xlup).row+1, to 2 step -1
if not isempty(cells(i,1)) and isempty(cells(i+1)) and
isempty(cells(i-1,1) then
cells(i+1,1).Value = cells(i,1).Value
end if
Next
Click to expand...

Thank you, some minor syntactiv corrections are required:
Sub ConditionalDuplicateCell()
For i = Cells(Rows.Count, 1).End(xlUp).Row + 1 To 2 Step -1
If Not IsEmpty(Cells(i, 1)) And IsEmpty(Cells(i + 1, 1)) And
IsEmpty(Cells(i - 1, 1)) Then
Cells(i + 1, 1).Value = Cells(i, 1).Value
End If
Next
End Sub

Luckily the Microsoft VB-Debugger is quite comfortable to use. ;)
The code does exactly what it is supposed to do for (the hard-coded)
column 1. Any hint how I can determine the selected column (and warn
if the user has selected more than one column)?

Many thanks again,
--Joachim
 
I only saw one syntax/typo correction <g>

Sub ConditionalDuplicateCell()
Dim icol as Long, i as long
if selection.Columns.Count > 1 then
msgbox "Please only select 1 column"
exit sub
End if
icol = ActiveCell.Column
For i = Cells(Rows.Count, icol).End(xlUp).Row + 1 To 2 Step -1
If Not IsEmpty(Cells(i, icol)) And _
IsEmpty(Cells(i + 1, icol)) And _
IsEmpty(Cells(i - 1, icol)) Then
Cells(i + 1, icol).Value = Cells(i, icol).Value
End If
Next
End Sub
 
I only saw one syntax/typo correction <g>
Click to expand...

Agreed. The second one was no typo but without a minor change it did
not do what I wanted it to... ;) Both are obvious if you're used to
the language syntax but somehow difficult to find if you never-ever
touched a line of VB before.
Sub ConditionalDuplicateCell()
Dim icol as Long, i as long
if selection.Columns.Count > 1 then
msgbox "Please only select 1 column"
exit sub
End if
icol = ActiveCell.Column
For i = Cells(Rows.Count, icol).End(xlUp).Row + 1 To 2 Step -1
If Not IsEmpty(Cells(i, icol)) And _
IsEmpty(Cells(i + 1, icol)) And _
IsEmpty(Cells(i - 1, icol)) Then
Cells(i + 1, icol).Value = Cells(i, icol).Value
End If
Next
End Sub
Click to expand...

Excellent, many thanks again and again!

Regards
--Joachim
 
Back
Top