Hi group,
Can someone help with this problem:

I want to search column B for empty cells.
If an empty cell is found then the value in the same row in column C should
be moved to column D and one row up
If a new empty cell is found in column B right below the first cell that was
found, then the value in column C should be moved to column E, and this time
two rows up.
In other words Excel VBA needs to distinguish between one empty cell or two
emty cells after each other.

Is this possible?

Best regards,
Kaj Pedersen

Okay, I've got to ask... what should happen if 3 (or more) contiguous empty
cells are found in Column B?

Rick Rothstein (MVP - Excel)

This will never happen.

"Rick Rothstein" skrev i en meddelelse
...
Okay, I've got to ask... what should happen if 3 (or more) contiguous
empty cells are found in Column B?

Rick Rothstein (MVP - Excel)

Okay, I've got to ask... what should happen if 3 (or more) contiguous
empty cells are found in Column B?

This will never happen.

Okay, give this macro a try...

Sub ProcessBlanksInColumnB()
Dim Blanks As Range, LastRow As Long, A As Range
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
Set Blanks = Range("B1:B" & LastRow).SpecialCells(xlCellTypeBlanks)
For Each A In Blanks.Areas
If A.Count = 1 Then
A.Offset(-1, 2).Value = A.Offset(, 1).Value
Else
A.Offset(-2, 3).Value = A.Offset(, 1).Value
End If
A.Offset(, 1).Clear
Next
End Sub

Rick Rothstein (MVP - Excel)

Hi,
Unfortunately there seems to be a problem.
If one empty cell is found it works perfectly, but if two are found right
after each other, both of the values in column C are moved to column E.
The value corresponding to the first empty cell is moved two rows up. The
last found is moved one row up.
Even with two empty cells after each other, the first one should be moved
only to column D and one row up
The next and last should be moved to column E and two rows up.

I have tried to change the values without luck.
Perhaps you have a suggestion?

Kaj Pedersen

"Rick Rothstein" skrev i en meddelelse
...
Okay, I've got to ask... what should happen if 3 (or more) contiguous
empty cells are found in Column B?

This will never happen.

Okay, give this macro a try...

Sub ProcessBlanksInColumnB()
Dim Blanks As Range, LastRow As Long, A As Range
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
Set Blanks = Range("B1:B" & LastRow).SpecialCells(xlCellTypeBlanks)
For Each A In Blanks.Areas
If A.Count = 1 Then
A.Offset(-1, 2).Value = A.Offset(, 1).Value
Else
A.Offset(-2, 3).Value = A.Offset(, 1).Value
End If
A.Offset(, 1).Clear
Next
End Sub

Rick Rothstein (MVP - Excel)

What I wrote was wrong:

"The value corresponding to the first empty cell is moved two rows up. The
last found is moved one row up."

Both of them are moved two rows up.

Kaj Pedersen



"KP" <none skrev i en meddelelse
b.com...
Hi,
Unfortunately there seems to be a problem.
If one empty cell is found it works perfectly, but if two are found right
after each other, both of the values in column C are moved to column E.
The value corresponding to the first empty cell is moved two rows up. The
last found is moved one row up.
Even with two empty cells after each other, the first one should be moved
only to column D and one row up
The next and last should be moved to column E and two rows up.

I have tried to change the values without luck.
Perhaps you have a suggestion?

Kaj Pedersen

"Rick Rothstein" skrev i en
meddelelse ...
Okay, I've got to ask... what should happen if 3 (or more) contiguous
empty cells are found in Column B?

This will never happen.

Okay, give this macro a try...

Sub ProcessBlanksInColumnB()
Dim Blanks As Range, LastRow As Long, A As Range
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
Set Blanks = Range("B1:B" & LastRow).SpecialCells(xlCellTypeBlanks)
For Each A In Blanks.Areas
If A.Count = 1 Then
A.Offset(-1, 2).Value = A.Offset(, 1).Value
Else
A.Offset(-2, 3).Value = A.Offset(, 1).Value
End If
A.Offset(, 1).Clear
Next
End Sub

Rick Rothstein (MVP - Excel)

Hi Kaj,

Am Wed, 21 Sep 2011 20:48:23 +0200 schrieb KP:

Even with two empty cells after each other, the first one should be moved
only to column D and one row up
The next and last should be moved to column E and two rows up.

change the IF-block of Rick's code:

For Each A In Blanks.Areas
If A.Count = 2 Then
A.Cells(1).Offset(-1, 2).Value = A.Cells(1).Offset(, 1).Value
A.Cells(2).Offset(-2, 3).Value = A.Cells(2).Offset(, 1).Value
Else
A.Offset(-1, 2).Value = A.Offset(, 1).Value
End If
A.Offset(, 1).Clear
Next


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2