Excel Macro to insert row based on data [Solved/Closed]

- - Latest reply:  Asa - Jan 19, 2012 at 11:39 AM
Hello,
I have a large spreadsheet w/ over 9,000 rows of data. I would like to know if a macro can be built to add a row(s) based on the month. In the example below I would need rows inserted for Vendor "A" at "month" 4,5,6,7,8,10 and 11. Rows inserted for Vendor "B" for "Month" 1,2,3,4,6,7,8,9,10,11 and 12. And the macro to continue through the entire spreadsheet.

Thank you in advance for any assistance provided.

Currently looks like:
Vendor Year Month
A 2011 1
A 2011 2
A 2011 3
A 2011 9
A 2011 12
B 2011 5
B 2011 11
C 2011 9
C 2011 12
D 2011 1
D 2011 2
D 2011 3
D 2011 4
D 2011 6
D 2011 7
D 2011 9
D 2011 10
D 2011 12

Want to look Like:
Vendor Year Month
A 2011 1
A 2011 2
A 2011 3
A 2011 4
A 2011 5
A 2011 6
A 2011 7
A 2011 8
A 2011 9
A 2011 10
A 2011 11
A 2011 12
B 2011 1
B 2011 2
B 2011 3
B 2011 4
B 2011 5
B 2011 6
B 2011 7
B 2011 8
B 2011 9
B 2011 10
B 2011 11
B 2011 12
C 2011 1
C 2011 2
C 2011 3
C 2011 4
C 2011 5
C 2011 6
C 2011 7
C 2011 8
C 2011 9
C 2011 10
C 2011 11
C 2011 12
D 2011 1
D 2011 2
D 2011 3
D 2011 4
D 2011 5
D 2011 6
D 2011 7
D 2011 8
D 2011 9
D 2011 10
D 2011 11
D 2011 12




See more 

2 replies

Best answer
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
784
1
Thank you
many ways doing it. see whether the macro "test" helps
data is from A1 to C19

Sub undo()
Range("D1:H1").EntireColumn.Delete
Worksheets("sheet1").Cells.Clear
Worksheets("sheet2").Cells.Copy Worksheets("sheet1").Range("a1")
Application.CutCopyMode = False
End Sub



Sub test()
Dim r As Range, vendor As Range, cvendor As Range
Dim j As Long, cfind As Range, dest As Range, rdest As Range
Application.ScreenUpdating = False
undo
Worksheets("sheet1").Activate
Set r = Range(Range("A1"), Range("A1").End(xlDown))
r.AdvancedFilter xlFilterCopy, , Range("d1"), True
Set vendor = Range(Range("D2"), Range("D2").End(xlDown))
For Each cvendor In vendor
j = WorksheetFunction.CountIf(r, cvendor.Value)
If j <> 12 Then
Set cfind = r.Find(what:=cvendor.Value, lookat:=xlWhole)
Set dest = Cells(Rows.Count, "F").End(xlUp).Offset(1, 0)
Range(cfind, cfind.Offset(0, 1)).Copy Range(dest, dest.Offset(11, 0))
dest.Offset(0, 2) = 1
Set rdest = Range(dest.Offset(0, 2), dest.Offset(11, 2))
'MsgBox rdest.Address
rdest.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
       Step:=1, Stop:=12, Trend:=False
Else
Set dest = Cells(Rows.Count, "F").End(xlUp).Offset(1, 0)
Range(cfind, cfind.Offset(11, 2)).Copy dest
End If
Next cvendor
Range("D1").EntireColumn.Cells.Clear
MsgBox "macro over"
Application.ScreenUpdating = True
End Sub

Say "Thank you" 1

A few words of thanks would be greatly appreciated. Add comment

CCM 6087 users have said thank you to us this month

Thank you for your efforts. However the macro doesn't work. It send the speadsheet into an endless "no response" mode in which I have to go to the task manager to end the excel program.
Perfect. I did not copy from sheet 1 to sheet 2 on the first attempt. After copying data to sheet 2 macro works.

Thank you so much for your time and effort.
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
784
1
Thank you
I am sending the file through speedyshare.com
download it from

http://speedy.sh/93pEW/ASA.xls

your main data is A1 to C19

copy this data that is A1:c19 to sheet2 also from A1 in that sheet
the result is column F to H

the macro is in vbeditor module

first run the macro in this file
if it is ok try in your file

find out whether there is confrontational difference between this file and your file

Say "Thank you" 1

A few words of thanks would be greatly appreciated. Add comment

CCM 6087 users have said thank you to us this month