backfill cells with macros

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I am trying to figure out a way to backfill blank cells in Excel on the same
row. For example:

column A B C D

1 x x x o
2 x x o o
3 x x x o

In row 1 I want the information in cell 1D populate the blank cells in
column 1A,1B, and 1C
In row 2 I want the information in cell 2C to poplulate the blank cells in
column 2A and 2B

Ideally, I want Excel to realize that there are blank cells in a row and
fill those blank cells with the first information it finds on that row.
 
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)
 
This worked on a small test area:

Sub bckfl()
Dim x, y As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
i = 2
For Each y In Range("A2:A" & lr)
lc = Cells(i, Columns.Count).End(xlToLeft).Column
For Each x In Range(Cells(i, 1), Cells(i, lc))
If x = "" And x.Offset(0, 1) = "" Then
Range("A" & i, x.End(xlToRight).Offset(0, -1)) = x.End(xlToRight).Value
ElseIf x = "" And x.Offset(0, 1) <> "" Then
x.Offset(0, 0) = x.Offset(0, 1).Value
End If

Next x
i = i + 1
Next y
End Sub

Might need some tweaking for your application.
 
This worked on a small test area:

Sub bckfl()
Dim x, y As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
i = 2
For Each y In Range("A2:A" & lr)
lc = Cells(i, Columns.Count).End(xlToLeft).Column
For Each x In Range(Cells(i, 1), Cells(i, lc))
If x = "" And x.Offset(0, 1) = "" Then
Range("A" & i, x.End(xlToRight).Offset(0, -1)) = x.End(xlToRight).Value
ElseIf x = "" And x.Offset(0, 1) <> "" Then
x.Offset(0, 0) = x.Offset(0, 1).Value
End If

Next x
i = i + 1
Next y
End Sub

Might need some tweaking for your application.









- Show quoted text -
Click to expand...

Hi,

How about:

Sub FillRight()
With Range("A1:D" & Cells(65536,1).end(xlup).row)
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[1]"
.Formula = .Value
End With
End Sub

James
 
Hi James,

It works OK except that if there are blanks to the right of an entry
it produces zeros to the end of the row within the range.

[email protected] said:
This worked on a small test area:

Sub bckfl()
Dim x, y As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
i = 2
For Each y In Range("A2:A" & lr)
lc = Cells(i, Columns.Count).End(xlToLeft).Column
For Each x In Range(Cells(i, 1), Cells(i, lc))
If x = "" And x.Offset(0, 1) = "" Then
Range("A" & i, x.End(xlToRight).Offset(0, -1)) = x.End(xlToRight).Value
ElseIf x = "" And x.Offset(0, 1) <> "" Then
x.Offset(0, 0) = x.Offset(0, 1).Value
End If

Next x
i = i + 1
Next y
End Sub

Might need some tweaking for your application.









- Show quoted text -
Click to expand...

Hi,

How about:

Sub FillRight()
With Range("A1:D" & Cells(65536,1).end(xlup).row)
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[1]"
.Formula = .Value
End With
End Sub

James
Click to expand...
 
I apologise Jason,

the FirstInRow function should have used the xlNext direction, not xlPrevious:

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:=xlNext).Column
On Error GoTo 0
Exit Function
ItemsInRowError:
On Error GoTo 0
FirstInRow = 0
End Function

I wasn't sure how specific your original query was (ie 4 columns, 3 rows) so
this solution works for the whole sheet.

Cheers,

Sean.
 
Hey, any chance you can walk me through how to add this to a Excel 2007
worksheet?

JLGWhiz said:
Hi James,

It works OK except that if there are blanks to the right of an entry
it produces zeros to the end of the row within the range.

[email protected] said:
This worked on a small test area:

Sub bckfl()
Dim x, y As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
i = 2
For Each y In Range("A2:A" & lr)
lc = Cells(i, Columns.Count).End(xlToLeft).Column
For Each x In Range(Cells(i, 1), Cells(i, lc))
If x = "" And x.Offset(0, 1) = "" Then
Range("A" & i, x.End(xlToRight).Offset(0, -1)) = x.End(xlToRight).Value
ElseIf x = "" And x.Offset(0, 1) <> "" Then
x.Offset(0, 0) = x.Offset(0, 1).Value
End If

Next x
i = i + 1
Next y
End Sub

Might need some tweaking for your application.



:
I am trying to figure out a way to backfill blank cells in Excel on the same
row. For example:

column A B C D

1 x x x o
2 x x o o
3 x x x o

In row 1 I want the information in cell 1D populate the blank cells in
column 1A,1B, and 1C
In row 2 I want the information in cell 2C to poplulate the blank cells in
column 2A and 2B

Ideally, I want Excel to realize that there are blank cells in a row and
fill those blank cells with the first information it finds on that row.- Hide quoted text -

- Show quoted text -
Click to expand...

Hi,

How about:

Sub FillRight()
With Range("A1:D" & Cells(65536,1).end(xlup).row)
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[1]"
.Formula = .Value
End With
End Sub

James
Click to expand...
Click to expand...
 
Any chance you can tell me how to add this to the Excel 2007 worksheet?

JLGWhiz said:
Hi James,

It works OK except that if there are blanks to the right of an entry
it produces zeros to the end of the row within the range.

[email protected] said:
This worked on a small test area:

Sub bckfl()
Dim x, y As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
i = 2
For Each y In Range("A2:A" & lr)
lc = Cells(i, Columns.Count).End(xlToLeft).Column
For Each x In Range(Cells(i, 1), Cells(i, lc))
If x = "" And x.Offset(0, 1) = "" Then
Range("A" & i, x.End(xlToRight).Offset(0, -1)) = x.End(xlToRight).Value
ElseIf x = "" And x.Offset(0, 1) <> "" Then
x.Offset(0, 0) = x.Offset(0, 1).Value
End If

Next x
i = i + 1
Next y
End Sub

Might need some tweaking for your application.



:
I am trying to figure out a way to backfill blank cells in Excel on the same
row. For example:

column A B C D

1 x x x o
2 x x o o
3 x x x o

In row 1 I want the information in cell 1D populate the blank cells in
column 1A,1B, and 1C
In row 2 I want the information in cell 2C to poplulate the blank cells in
column 2A and 2B

Ideally, I want Excel to realize that there are blank cells in a row and
fill those blank cells with the first information it finds on that row.- Hide quoted text -

- Show quoted text -
Click to expand...

Hi,

How about:

Sub FillRight()
With Range("A1:D" & Cells(65536,1).end(xlup).row)
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[1]"
.Formula = .Value
End With
End Sub

James
Click to expand...
Click to expand...
 
I am getting an error in VB and I don't know enough about VB to understand
the error. Please see below

"sub or function not defined" and VB highlights FirstInRow

intFirstItemCol = FirstInRow(ActiveSheet, lngRowCounter)
 
This worked but, it worked too well. In otherwords, this is what happen

A B C D E
1 x x x O O
2 x x O x T

On line 1 the code worked great, however, on line 2 the code seen the blank
 
Back
Top