Copy cells down

[Guest]

I'm returning to Excel VBA after a brief introduction to it some months ago.
Using Excel 2000.
I have a report that I import into Excel. I want to transform it into a
Excel List.
First I need to copy any value in Column A down while the cell in Column B
for the same row contains data.
I then need to clear the cell that was orignally copied.
Last, I need to take the information in Column A and delete all rows in the
UsedRange for which Column A is blank.

An example:
Cell A7 contains a name.
B8:B12 contain the dates the person will work.
I want the person's name to appear in A8:A12, and then clear cell A7.
Then, I would like Excel to find the next name and repeat the process. The
first person will always be in A7, but names after that will be in different
cells weekly.

I think I need some combination of offset, if and a do loop, but I've been
unable to come up with anything that even gets close.

Any help would be greatly appreciated.

 

[RC-]

Couple of quick questions:

Will cell B7 contain data?

Will cells B8:B12 always be the same size, in other words, will it always be
4 days, or will it flucuate?

The names will always be in column A?

Dates will always be in column B?

 

[Guest]

Couple of quick questions:

Will cell B7 contain data?

B7 will always be empty.

Will cells B8:B12 always be the same size, in other words, will it always be
4 days, or will it flucuate?

It will fluctuate.

The names will always be in column A?
Not necessarily but usually.

 

[Guest]

Here is what I have so far. It hangs after copying twice.

Sub TestCode()

For Each c In Range("A7:A200")
If c.Formula <> "" Then
Do
c.Copy c.Offset(1, 0)
Loop While c.Offset(0, 1) <> ""
Else
End If
Next c

End Sub

 

[RC-]

Sorry for the delay. Check this out:

Column A Column B
7 Bill Smith
3/15/2005
3/16/2005
3/30/2005
4/16/2005
Alex Baldwin
3/15/2005
3/16/2005
3/30/2005
4/16/2005
4/17/2005
4/19/2005
Kim Basinger
3/30/2005
4/16/2005
4/17/2005
4/19/2005

Enter this data into a spreadsheet starting at row A7

Here is the code that will (hopefully) do what your asking for:

There's a private sub routine and a function. Copy and paste the code into
the ThisWorkBook object. Hit F8 to cycle through the code line by line (I'm
sure you knew that though).

Option Explicit
Dim sUBound, sLBound As String 'Upper and Lower boundries
Dim sNextRange As String 'Holds the next range string
Dim sFirstRange As String 'Holds the first range string
Dim bolNextRange As Boolean 'Determins if next range has data

Private Sub CreateReport()
Dim strName As String
Dim intNameCount As Integer
Dim strFillRange As String

bolNextRange = True

'Cell A7 is the starting cell
sFirstRange = "A7"
Range(sFirstRange).Select

Do Until bolNextRange = False

Selection.Copy

GetDateRange

strFillRange = Replace(sUBound, "B", "A") & ":" & Replace(sLBound, "B",
"A")

Range(strFillRange).Select
ActiveSheet.Paste
Range(sFirstRange).Select
Application.CutCopyMode = False
Selection.ClearContents
Range(sNextRange).Select
sFirstRange = sNextRange

Loop

End Sub

Function GetDateRange()

ActiveCell.Offset(RowOffset:=1, ColumnOffset:=1).Select

'Upper boundry
sUBound = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
Do Until ActiveCell.Offset(RowOffset:=1).Value = ""
ActiveCell.Offset(RowOffset:=1).Select


Loop
sLBound = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
sNextRange = ActiveCell.Offset(RowOffset:=1,
ColumnOffset:=-1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
If ActiveCell.Offset(RowOffset:=1, ColumnOffset:=-1).Value = "" Then
bolNextRange = False
Else
bolNextRange = True
End If


End Function

If you have any questions on the code, let me know ' )

HTH

Happy Coding

 

[Dave Peterson]

Debra Dalgleish has some techniques (manually and code) to fill that range:

http://www.contextures.com/xlDataEntry02.html

But this may work for you. I deleted the rows based on column b and never
emptied that value in A--but since the row was deleted, I didn't see the
purpose.

Option Explicit
Sub testme()

Dim myRng As Range
Dim myEmptyRng As Range
Dim LastRow As Long
Dim wks As Worksheet

Set wks = ActiveSheet
With wks
LastRow = .Cells(.Rows.Count, "B").End(xlUp)
Set myRng = .Range("a1:A" & LastRow)
Set myEmptyRng = Nothing
On Error Resume Next
Set myEmptyRng = myRng.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If myEmptyRng Is Nothing Then
'do nothing
Else
myEmptyRng.FormulaR1C1 = "=r[-1]c"
With myRng
.Value = .Value
End With
End If

On Error Resume Next
.Range("B:b").Cells.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End With

End Sub

 

[Tom Ogilvy]

If your data is like this:

A
01/01/2005
01/02/2005
01/03/2005
01/04/2005
B
01/06/2005
01/07/2005
01/08/2005
01/09/2005
01/10/2005


then you can use this:
This assumes that the cells in column B that are next to populated cells in
column A are blank.


Sub CC()
Dim rng As Range, rng1 As Range
Dim ar As Range
Set rng = Range("B8", Cells(Rows.Count, 2).End(xlUp))
On Error Resume Next
Set rng1 = rng.SpecialCells(xlConstants)
On Error GoTo 0
If rng1 Is Nothing Then Exit Sub
For Each ar In rng1.Areas
ar.Offset(0, -1).Value = ar(0, 0).Value
ar(0, 0).ClearContents
Next
Set rng = Range("A7", Cells(Rows.Count, 2).End(xlUp))
Set rng1 = Nothing
On Error Resume Next
Set rng1 = rng.SpecialCells(xlBlanks)
On Error GoTo 0
If Not rng1 Is Nothing Then
rng1.EntireRow.Delete
End If
End Sub

 

[Tom Ogilvy]

My sample data should have looked like RC's example. Guess email spacing
got me again. Not sure how it lost all spacing.

 

[Guest]

Thanks to everyone who responded. I made a crude macro that gets the job
done, but I already see some ways to improve the code significantly based on
your help.
Thank you Tom, RC and Dave.

tj