inserting columns and field headings for years

[dan graziano]

Hi,

I have an excel worksheet which has the following field headings for
sales data which start on row 6 of the worksheet:

company country 1980 1983 1984 1987 1988 etc.
Pepsi USA 100 200 333 224 298

The years start at column 3. In the final data set, there actually
should be a column and year field heading for each year from 1980 to
2000. However, in many worksheets the years included are irregular with
years skipped in-between such as above.

How would be the best way to macro automate so that the computer
automatically inserts a column and field heading whenever there is a
year missing to make a full series from 1980 to 2000?

For example, the above data set would be converted to:

company country 1980 1981 1982 1983 1984 etc. to 2000
Pepsi USA 100 200 333

Thanks and best regards,

Dan

 

[Soo Cheon Jheong]

Dan,

- - - - - - - - - - - - - - - - - - - - - - - - - -
Option Explicit
Sub TEST()

Dim RNG As Range
Dim a As Range
Dim b As Range
Dim N As Integer

Const Y1 As Integer = 1980
Const Y2 As Integer = 2000

Set RNG = Range("C1:G15")

N = 1
Do Until N > Y2 - Y1

Set a = RNG(1, N + 0)
Set b = RNG(1, N + 1)

If a.Value < b.Value - 1 Or b.Value = 0 Then
b.EntireColumn.Insert
a.EntireColumn.Copy b(1, 0)
b(1, 0).EntireColumn.ClearContents
b(1, 0).Value = a.Value + 1
End If
N = N + 1
Loop

End Sub
- - - - - - - - - - - - - - - - - - - - - - - - - -


--
Regards,
Soo Cheon Jheong
_ _
^¢¯^
--

 

[Guest]

Without writing specific code here is the general flow of the solution...

'On row 6 find the right most column...
Activesheet.range("A6").Specialcells(xlLeft).select

'Check to see if the number is 2000 if not move right and insert 2000
if Activecell.value < 2000 then
activecell.offset(0,-1).select
Activecell.value = 2000
endif

'loop until you find 1980
do while activecell.value > 1980
'Now you can check the activecell againxt the cell to the left
if activecell.value - activecell.offset(0, -1).value <> 0 then
activecell.entirerow.insert
endif
activecell.offset(0, -1).select
loop

or generally something like that give or take some debugging...

 

[Don Lloyd]

Hi,
The following is a variation on Jim's method including specific code.

Sub Years1980_2000()
Dim Rw, Col, Diff, x, Yr, Hdg
Rw = 6: Col = 3
Hdg = Cells(Rw, 2)
Cells(Rw, 2) = 1979
Do
Diff = Cells(Rw, Col) - Cells(Rw, Col - 1)
If Diff > 1 Then
For x = 1 To Diff - 1
Columns(Col).Insert
Cells(Rw, Col) = Cells(Rw, Col - 1) + 1
Col = Col + 1
Next
ElseIf Diff < 0 Then
For x = 1 To 2000 - Yr
Columns(Col).Insert
Cells(Rw, Col) = Cells(Rw, Col - 1) + 1
Col = Col + 1
Next
End If
Yr = Cells(Rw, Col)
Col = Col + 1
Loop Until Cells(Rw, Col - 2) = 2000 Or Yr = 2000
Cells(Rw, 2) = Hdg
End Sub

It looks a bit kludgy but it works!
In case the first year on the sheet is >1980, column 2 is used to
temporarily contain 1979.
If the last year on the sheet is < 2000, then extra columns are inserted to
avoid the possibility of overwriting data.
Note: Ensure there are no blank dates in the original sheet

 

[Don Lloyd]

Hi,
Ignore my last post - it was way past my bedtime.
The following does the job better.

Sub YearsInsert()
Dim Rw, Col, Yr
Rw = 6: Col = 4: Yr = 1980
Do
If Cells(Rw, Col) <> Yr Then
Columns(Col).Insert
Cells(Rw, Col) = Yr
End If
Col = Col + 1: Yr = Yr + 1
Loop Until Yr = 2001
End Sub

regards,
Don Lloyd

 

[dan graziano]

Many thanks to everyone for the suggestions and code on inserting the
columns and field headings!

Dan