automate fill handle process

[pb1]

I received a spreadsheet that needs to be sorted, however, before it ca
be sorted several cells need to be filled with data. So far, do t
this I used the fill handle, but since there are several records in th
spreadsheet is takes time to run this process.

Is it possible to automate this.

Here is what the information would look like in Excel.

IND(text field) Data
789 xxxxx
yyyyy
zzzzz
---------
899 xxxxx
yyyyy
zzzzz
wwww
---------
777 xxxxx
yyyyy
---------
999 xxxxx
yyyyy
zzzzz
---------

I need it to look like this:

IND(text field) Data
789 xxxxx
789 yyyyy
789 zzzzz

 

[Dave Peterson]

What are those ----------'s?

I guessed that they were in the posting only--for readability's sake.

If that's true, then save your workbook and try this (it destroys the data, so
close without saving if it's not what you want.)

Option Explicit
Sub testme01()

Dim myRng As Range
Dim myArea As Range
Dim wks As Worksheet

Set wks = ActiveSheet

With wks
Set myRng = Nothing
On Error Resume Next
Set myRng = .Range("b:b").Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If myRng Is Nothing Then
MsgBox "Nothing found!"
Exit Sub
End If

For Each myArea In myRng.Areas
With myArea
.Value = .Offset(0, -1).Value
.Offset(0, -1).ClearContents
End With
Next myArea

'now do column A
Set myRng = Nothing
On Error Resume Next
Set myRng = .Range("a:a").Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If myRng Is Nothing Then
'shouldn't happen--since we just did a .clearcontents
MsgBox "nothing found in column A"
Exit Sub
End If

With myRng
.FormulaR1C1 = "=r[-1]c"
.Value = .Value
End With

End With

End Sub


If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

If those ------ represented blank rows, then delete them before starting (or
delete them when you're done.

If you select column A (before) or B (after), you can:
Edit|goto|special|Blanks
Edit|delete|entire row

 

[Dave Peterson]

Oops. There is a bug in that first macro. Use this one instead:

Option Explicit
Sub testme01()

Dim myRng As Range
Dim myArea As Range
Dim wks As Worksheet

Set wks = ActiveSheet

With wks
Set myRng = Nothing
On Error Resume Next
Set myRng = .Range("b:b").Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If myRng Is Nothing Then
MsgBox "Nothing found!"
Exit Sub
End If

For Each myArea In myRng.Areas
With myArea
.Value = .Offset(0, -1).Value
.Offset(0, -1).ClearContents
End With
Next myArea

'now do column A
Set myRng = Nothing
On Error Resume Next
Set myRng = .Range("a:a").Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If myRng Is Nothing Then
'shouldn't happen--since we just did a .clearcontents
MsgBox "nothing found in column A"
Exit Sub
End If

myRng.FormulaR1C1 = "=r[-1]c"
With .Range("a:a")
.Value = .Value
End With

End With

End Sub

The section at the bottom changed from this:

With myRng
.FormulaR1C1 = "=r[-1]c"
.Value = .Value
End With