Thank you, Thank you, Thank you!

Carrie

Dave Peterson wrote:
Oops. I added some code at the end and I put it in the wrong spot.

Option Explicit
Sub Testme01()

Dim TopCell As Range
Dim BotCell As Range
Dim wks As Worksheet
Dim iCol As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim RngToSearch As Range
Dim FirstAddress As String
Dim HowManyRowsToFill As Long

Set wks = Worksheets("sheet1")

With wks
FirstCol = .Range("e3").Column
LastCol = .Range("au3").Column
For iCol = FirstCol To LastCol
FirstAddress = ""
Set RngToSearch _
= .Range(.Cells(3, iCol), .Cells(.Rows.Count, iCol).End(xlUp))
With RngToSearch
Set TopCell = .Cells.Find(what:="1", _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With

If TopCell Is Nothing Then
'nothing to do in this column
MsgBox "no 1's in column: " & ColLetter(iCol)
Else
FirstAddress = TopCell.Address
Do
With RngToSearch
Set BotCell = .Cells.Find(what:="2", _
After:=TopCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With

'check for nothing first!
If BotCell Is Nothing Then
MsgBox "No corresponding 2's in column: " _
& ColLetter(iCol)
Exit Do
End If

If BotCell.Row < TopCell.Row Then
MsgBox "No trailing 2 for last 1 in column: " _
& ColLetter(iCol)
Exit Do
End If

HowManyRowsToFill = BotCell.Row - TopCell.Row - 1
If HowManyRowsToFill 0 Then
TopCell.Offset(1, 0) _
.Resize(HowManyRowsToFill, 1).Value = 1
End If

'try to find the next 1
With RngToSearch
Set TopCell = .Cells.Find(what:="1", _
After:=BotCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With

If TopCell.Address = FirstAddress Then
'at the top of the column again
'get out and do the next column
Exit Do
End If
Loop
End If
Next iCol
End With
End Sub
Function ColLetter(myNum As Long) As String
Dim myStr As String
myStr = Worksheets(1).Cells(1, myNum).Address(0, 0)
myStr = Left(myStr, Len(myStr) - 1)
ColLetter = myStr
End Function

This is awsome! Wow! - It does exactly what I want! Thank you so much

[quoted text clipped - 183 lines]
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200802/1


--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200802/1