You are here:

Excel/Spread Years Macro

Advertisement


Question
QUESTION: Hi Tom, I had asked you a question the other day and you had referred me to Bob who unfortunately also couldn't help.  I do appreciate both of you considering my last question though.  

I've come up with a function that works but I need what I'm hoping is a simple macro to finalize it.  I have 2 relevant columns - Company and Year.  Companies can have multiple entries by year, and years span from 2007 to 2012.  I'd like a macro that fills out the years and copies all the other columns except one in the spreadsheet.  

For example Column A has Company name, column AC has year.  If ABC Company ordered in 2012 and 2009, I click run on the macro, it adds rows for ABC with years 2011, 2010, 2008 and 2007, and changes Column AM (currently "Yes") to "No" while keeping all other values the same in all columns.  

If this isn't possible, I again thank you for your thoughts.

ANSWER: BIll

Let's say your data values start in row 2 and you have no blank rows to the bottom of your data.  You didn't say where to fill out the data so I will assume the new rows should go to the bottom of the sheet (You can always sort on column A and Column AC).  Also assume that column A is a unique value so if I count column A it will tell me how many years that company is in the data.  ( I am not sure this reflects you example in your first question where you had company ABC in California and New York - it that type of situation needs to be considered, the macro could be altered to do that. )

Sub abc()
Dim rw As Long, cnt As Long, rw1 As Long, i As Long
rw = 2
Do While Cells(rw, "A") <> ""
 cnt = Application.CountIf(Columns(1), Cells(rw, "A"))
 If cnt > 1 And cnt < 6 Then
   rw1 = Cells(Rows.Count, 1).End(xlUp).Row + 1
   For i = 2007 To 2012
     If Application.CountIfs(Columns(1), Cells(rw, 1), Columns(29), i) = 0 Then
       Rows(rw).Copy Rows(rw1)
       Cells(rw1, "AC").Value = i
       Cells(rw1, "AM").Value = "No"
     End If
   Next i
 End If
 rw = rw + 1
 Debug.Print rw
Loop
End Sub

You should test this on a copy of your data since until you are satisfied it does what you want.

--
Regards,
Tom Ogilvy
    

---------- FOLLOW-UP ----------

QUESTION: Thanks, Tom.  Quick follow up:

Column A is not unique.  In retrospect, there are 3 columns that are relevant.  A has company name, and is not unique as a company could exist with multiple years.

Column AB has the years, with at least 1 of the range from 2007 to 2012, and could have all 5.  Ultimately the goal is to fill in the blank years.

Column AM is a field I've created, all of which say "Yes" right now.  When the macro runs, I'd want any new rows added to have AM change to "No."  You can copy all other columns or leave all other columns blank, whichever is easiest.  

Thanks again

Answer

The only change I see is you originally said the years were in AC and now you say they are in AB

so to accomodate that change, the macro would be:


Sub abc()
Dim rw As Long, cnt As Long, rw1 As Long, i As Long
rw = 2
Do While Cells(rw, "A") <> ""
 cnt = Application.CountIf(Columns(1), Cells(rw, "A"))
 If cnt > 1 And cnt < 6 Then
   rw1 = Cells(Rows.Count, 1).End(xlUp).Row + 1
   For i = 2007 To 2012
     If Application.CountIfs(Columns(1), Cells(rw, 1), Columns(28), i) = 0 Then '<= changed
       Rows(rw).Copy Rows(rw1)
       Cells(rw1, "AB").Value = i   '<== changed
       Cells(rw1, "AM").Value = "No"
     End If
   Next i
 End If
 rw = rw + 1
'  Debug.Print rw
Loop
End Sub


--
Regards,
Tom Ogilvy

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.