Hi Jason,
Try this. This code will search for the last row with data in it, then work
back through that row and the ones above it, each time looking for the first
item of data in each row. The first cell occupied is then copied into all the
preceding cells in that row. If a row is empty then nothing is done on that
row. If data is already in the first column of a row then nothing is done in
that row. Let me know if this is OK, or if I've misunderstood.
Public Sub BackFill()
Dim lngLastRow As Long
Dim intFirstItemCol As Integer
Dim lngRowCounter As Long
Dim intColumnCounter As Integer
lngLastRow = LastRow(ActiveSheet)
If lngLastRow > 0 Then
For lngRowCounter = lngLastRow To 1 Step -1
intFirstItemCol = FirstInRow(ActiveSheet, lngRowCounter)
If intFirstItemCol > 1 Then
For intColumnCounter = intFirstItemCol - 1 To 1 Step -1
ActiveSheet.Cells(lngRowCounter, intColumnCounter) =
ActiveSheet.Cells(lngRowCounter, intFirstItemCol)
Next
Else
'EMPTY ROW OR DATA IN COLUMN 1 ALREADY
End If
Next
Else
MsgBox ("Nothing found on worksheet")
End If
End Sub
Private Function LastRow(ByRef Sheetname As Worksheet) As Long
On Error GoTo LastRowError
LastRow = Sheetname.Cells.Find(What:="*", _
After:=Sheetname.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
Exit Function
LastRowError:
On Error GoTo 0
LastRow = 0
End Function
Public Function FirstInRow(ByRef Sheetname As Worksheet, ByRef RowNum As
Long) As Integer
On Error GoTo ItemsInRowError
FirstInRow = Sheetname.Rows(RowNum).Find(What:="*", _
After:=Cells(RowNum, Columns.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
On Error GoTo 0
Exit Function
ItemsInRowError:
On Error GoTo 0
FirstInRow = 0
End Function
Sean.
(please remember to click yes if these replies are useful to you)
" & Cells(65536,1).end(xlup).row)