Previous Topic Next Topic

Excel Macro to insert row based on data

Solved/Closed
Asa - Jan 18, 2012 at 12:05 PM
 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




Related:

2 responses

Answer 1 / 2
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jan 19, 2012 at 03:50 AM
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
1
Asa
Jan 19, 2012 at 09:37 AM
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.
0
Asa
Jan 19, 2012 at 11:39 AM
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.
0
Answer 2 / 2
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jan 19, 2012 at 10:11 AM
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
1