Reputation:
The Situation:
On the Cell "A1" I have the value "1"
On the Cell "A10" I have the value "2"
On the Cell "A20" I have the value "3"
On the Cell "A30" I have the value "4"
What I want to do with Excel VBA:
Between A1 and A10 there are empty cells. I want that A2:A9 is filled with the value of A10, that means "2".
Between A10 and A20 there are empty cells. I want that A11:19 is filled with the value of A20, that means "3".
The problem is, the range A1 to A30 is not fixed. I want to search the whole row for cells which are not empty and to fill the cells between them with the upper cell which is filled.
EDIT:
To explain more, I have an Access Database with a table which is filled with Dates and a table which is filled with numbers.
I want to make a Report to an Excel Sheet.
Dim Daten As Variant
Daten = Array(rs!DatumJMinus8Monate, rs!DatumJ, rs!DatumI, rs!DatumH, rs!DatumG, rs!DatumF, rs!DatumE, rs!DatumD, rs!DatumC, rs!DatumB, rs!DatumA, rs!DatumA4Monate)
Dim Bedarfe As Variant
Bedarfe = Array(rs!BedarfJ8Monate, rs!BedarfJ, rs!BedarfI, rs!BedarfH, rs!BedarfG, rs!BedarfF, rs!Bedarfe, rs!BedarfD, rs!BedarfC, rs!BedarfB, rs!BedarfA, rs!BedarfA, "")
Dim neuereintrag As Boolean
bedarfindex = 0
For Each element In Daten
i = 7
For jahre = 1 To 10
If Cells(1, i + 1) = Year(element) Then
For monate = 1 To 12
If Cells(2, i + monate) = Month(element) Then
Cells(zeile, i + monate) = Bedarfe(bedarfindex)
Cells(zeile, i + monate).Font.Bold = True
bedarfindex = bedarfindex + 1
neuereintrag = True
ElseIf IsEmpty(Cells(zeile, i + monate)) Or neuereintrag = True Then
Cells(zeile, i + monate) = Bedarfe(bedarfindex)
neuereintrag = False
End If
Next monate
End If
i = i + 12
Next jahre
Next element
In the picture the numbers in the red circles have to be deleted.
Upvotes: 1
Views: 482
Reputation: 19837
Maybe something like this. It needs a bit of work as it will fail if two values are next to each other, or column 1 doesn't contain a value.
Sub AutoFill()
Dim rCell1 As Range, rCell2 As Range
With ThisWorkbook.Worksheets("Sheet1")
'Find the last column containing data, set both references to this
'so the Do While doesn't fall over on the first loop.
Set rCell2 = .Cells(1, .Columns.Count).End(xlToLeft) '1 is the row number it's looking at.
Set rCell1 = rCell2
'Find next cell to the left containing data and fill between these two columns.
Do While rCell1.Column <> 1
Set rCell1 = rCell2.End(xlToLeft)
.Range(rCell1, rCell2.Offset(, -1)).FillRight
Set rCell2 = rCell1
Loop
End With
End Sub
Upvotes: 0
Reputation: 96771
On way to work from the bottom upwards:
Sub FillUp()
Dim N As Long
Dim i As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
For i = N - 1 To 1 Step -1
If Cells(i, 1).Value = "" Then Cells(i, 1).Value = Cells(i + 1, 1).Value
Next i
End Sub
Upvotes: 0