Add rows

  • Thread starter Thread starter Robert Hargreaves
  • Start date Start date
R

Robert Hargreaves

I am trying to use code to find the next available empty row in a column (A)
and add amonths worth of days in rows and autofill the rows with formula,
conditional formatting, pattern of increment in formaul, dates & numbers etc

The code I use at present is like this

Range("A1").Select

Do

If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If

Loop Until IsEmpty(ActiveCell) = True

--- This line i dont know how to do....

Range(ActiveCell:Activecell - 1).Autofill
Destination:=Range("ActiveCell:????)

Can you tell me how to add a month to the column in days based on the entry
in the cell above the (ActiveCell).

If I can do this I can then I will be able to automate the deletion of a
month of rows and addition of a month of rows to keep the spreadsheet size
down.

Thanks for you help
Rob
 
iLastRow = Cells(Rows.Count,"A").End(xlUp).Row
Cells(iLastRow,"A").Autofill Cells(iLastRow,"A").Resize(2)

--

HTH

RP
(remove nothere from the email address if mailing direct)
 
I'm not quite sure I understand what you're doing, but maybe this'll give you an
idea:

Option Explicit
Sub testme()

Dim LastCell As Range

With ActiveSheet
Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
End With

With LastCell
.EntireRow.Copy _
Destination:=.Offset(1, 0)

If IsDate(.Value) Then
.Offset(1, 0).Value = DateSerial(Year(.Value), Month(.Value) + 1, 1)
.Offset(1, 0).NumberFormat = .NumberFormat
Else
MsgBox "Not a date!"
End If
End With

End Sub

It starts at the bottom of column A to find the last used cell. Then it copies
that whole row on the next row.

And sticks the first of the next month in column A of the new row.
 
yes bob but how do I fit it into my code?

I have tried as follows

Sub Addrows_Click()

Range("A1").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True

ActiveCell = Cells(Rows.Count, "A").End(xlUp).Row
Cells(ActiveCell, "A").AutoFill Cells(ActiveCell, "A").Resize(2)

End Sub

It doesnt work like this can you tell mewhy?

Thanks
Rob
 
This is all you need.

Sub Addrows_Click()
Dim iLastRow As Long

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(ActiveCell, "A").AutoFill Cells(ActiveCell, "A").Resize(2)

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)
 
Hi Bob,

I have modified my code which is now below. I have tried to add a variable
of mnthlgth as string and a number for each scenario to add a month under
the resize option.

I am getting an object required error.

Can you see why?

Thanks
Rob

Sub Addrows_Click()

Dim iLastRow As Long
Dim mnthlgth As String
Dim wsArchive As Worksheet

Set wsArchive = Workbooks("Archive.xls").Sheets(1)

If ActiveSheet.Range("$A$4").Value = #1/1/2005# Then
ActiveSheet.Rows("4:34").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:34").Delete
Set mnthlgth = 31
ElseIf ActiveSheet.Range("$A$4").Value = #2/1/2008# Then
ActiveSheet.Rows("4:32").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:32").Delete
Set mnthlgth = 29
ElseIf ActiveSheet.Range("$A$4").Value = #2/1/2012# Then
ActiveSheet.Rows("4:32").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:32").Delete
Set mnthlgth = 29
ElseIf ActiveSheet.Range("$A$4").Value = #2/1/2016# Then
ActiveSheet.Rows("4:32").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:32").Delete
Set mnthlgth = 29
ElseIf ActiveSheet.Range("$A$4") = #2/1/2005# Then
ActiveSheet.Rows("4:31").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:31").Delete
Set mnthlgth = 28
ElseIf ActiveSheet.Range("$A$4") = #3/1/2005# Then
ActiveSheet.Rows("4:34").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:34").Delete
Set mnthlgth = 31
ElseIf ActiveSheet.Range("$A$4") = #4/1/2005# Then
ActiveSheet.Rows("4:33").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:33").Delete
Set mnthlgth = 30
ElseIf ActiveSheet.Range("$A$4") = #5/1/2005# Then
ActiveSheet.Rows("4:34").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:34").Delete
Set mnthlgth = 31
ElseIf ActiveSheet.Range("$A$4") = #6/1/2005# Then
ActiveSheet.Rows("4:33").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:33").Delete
Set mnthlgth = 30
ElseIf ActiveSheet.Range("$A$4") = #7/1/2005# Then
ActiveSheet.Rows("4:34").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:34").Delete
Set mnthlgth = 31
ElseIf ActiveSheet.Range("$A$4") = #8/1/2005# Then
ActiveSheet.Rows("4:34").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:34").Delete
Set mnthlgth = 31
ElseIf ActiveSheet.Range("$A$4") = #9/1/2005# Then
ActiveSheet.Rows("4:33").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:33").Delete
Set mnthlgth = 30
ElseIf ActiveSheet.Range("$A$4") = #10/1/2005# Then
ActiveSheet.Rows("4:34").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:34").Delete
Set mnthlgth = 31
ElseIf ActiveSheet.Range("$A$4") = #11/1/2005# Then
ActiveSheet.Rows("4:33").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:33").Delete
Set mnthlgth = 30
ElseIf ActiveSheet.Range("$A$4") = #12/1/2005# Then
ActiveSheet.Rows("4:34").Cut
Destination:=wsArchive.Range("A65536").End(xlUp)
ActiveSheet.Rows("4:34").Delete
Set mnthlgth = 31
End If

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(iLastRow, "A").AutoFill Cells(iLastRow, "A").Resize(mnthlgth)

End Sub
 
Hi Rob,

A couple of things. Set is only used for objects, 31 etc is a value so you
just uses straight assignment. Also 31 is a number, so the storing variable
should be a n integer or long, not string.

I have also modified the code a bit to make it easier to read

Option Explicit

Sub Addrows_Click()

Dim iLastRow As Long
Dim mnthlgth As Long
Dim wsArchive As Worksheet
Dim rngLAst As Range

Set wsArchive = Workbooks("Archive.xls").Sheets(1)

Set rngLAst = wsArchive.Cells(Rows.Count, "A").End(xlUp)
With ActiveSheet
If .Range("$A$4").Value = #1/1/2005# Then
.Rows("4:34").Cut Destination:=rngLAst
.Rows("4:34").Delete
mnthlgth = 31
ElseIf .Range("$A$4").Value = #2/1/2008# Then
.Rows("4:32").Cut Destination:=rngLAst
.Rows("4:32").Delete
mnthlgth = 29
ElseIf .Range("$A$4").Value = #2/1/2012# Then
.Rows("4:32").Cut Destination:=rngLAst
.Rows("4:32").Delete
mnthlgth = 29
ElseIf .Range("$A$4").Value = #2/1/2016# Then
.Rows("4:32").Cut Destination:=rngLAst
.Rows("4:32").Delete
mnthlgth = 29
ElseIf .Range("$A$4").Value = #2/1/2005# Then
.Rows("4:31").Cut Destination:=rngLAst
.Rows("4:31").Delete
mnthlgth = 28
ElseIf .Range("$A$4").Value = #3/1/2005# Then
.Rows("4:34").Cut Destination:=rngLAst
.Rows("4:34").Delete
mnthlgth = 31
ElseIf .Range("$A$4").Value = #4/1/2005# Then
.Rows("4:33").Cut Destination:=rngLAst
.Rows("4:33").Delete
mnthlgth = 30
ElseIf .Range("$A$4").Value = #5/1/2005# Then
.Rows("4:34").Cut Destination:=rngLAst
.Rows("4:34").Delete
mnthlgth = 31
ElseIf .Range("$A$4").Value = #6/1/2005# Then
.Rows("4:33").Cut Destination:=rngLAst
.Rows("4:33").Delete
mnthlgth = 30
ElseIf .Range("$A$4").Value = #7/1/2005# Then
.Rows("4:34").Cut Destination:=rngLAst
.Rows("4:34").Delete
mnthlgth = 31
ElseIf .Range("$A$4").Value = #8/1/2005# Then
.Rows("4:34").Destination:= rngLAst
.Rows("4:34").Delete
mnthlgth = 31
ElseIf .Range("$A$4").Value = #9/1/2005# Then
.Rows("4:33").Cut Destination:=rngLAst
.Rows("4:33").Delete
mnthlgth = 30
ElseIf .Range("$A$4").Value = #10/1/2005# Then
.Rows("4:34").Cut Destination:=rngLAst
.Rows("4:34").Delete
mnthlgth = 31
ElseIf .Range("$A$4").Value = #11/1/2005# Then
.Rows("4:33").Cut Destination:=rngLAst
.Rows("4:33").Delete
mnthlgth = 30
ElseIf .Range("$A$4").Value = #12/1/2005# Then
.Rows("4:34").Cut Destination:=rngLAst
.Rows("4:34").Delete
mnthlgth = 31
End If
End With

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(iLastRow, "A").AutoFill Cells(iLastRow, "A").Resize(mnthlgth)

End Sub




--

HTH

RP
(remove nothere from the email address if mailing direct)
 
Back
Top