Thank you sir its working flawless I guess i need to to learn more VB i just
use to record macro but this was impossible doing that. And yeah you know how
bosses are they can change things at will thank you for your patience.



"JLatham" wrote:

I decided to tighten things up - no sense in you having to copy and modify
that section of code many times. I've set this thing up so that by making a
change to one (or two) Const values and then defining added elements of an
array, you can adjust it to any number of series. It does handle either
numeric entries or numbers as text entries in the series, or even a mix of
them.

First change Const NumberOfSeries = 2 to the number of series you need to
deal with, be it 1, 2, 3, 4 or 5 (at that point you're going to run out of
columns unless you're on Excel 2007). Then you just need to add code to
define the lower and upper value limits in the new array elements. Right now
that looks like this:
Limits(1, lowerPointer) = 101
Limits(1, upperPointer) = 150
Limits(2, lowerPointer) = 201
Limits(2, upperPointer) = 250

and if you went to 3 elements, then it might look something like this:
Limits(1, lowerPointer) = 101
Limits(1, upperPointer) = 150
Limits(2, lowerPointer) = 201
Limits(2, upperPointer) = 250
Limits(3, lowerPointer) = 301
Limits(3, upperPointer) = 350

and that's pretty much all you need to do.


Sub InsertNewColumnsAndMissingValues()
'two series involved: 101-250 and 201-250
'routine presumes no blank cells in series
'although obviously there are missing values
'

Const NumberOfSeries = 2 ' change as required
Const EndOfSeriesPhrase = "TOTAL" ' use all caps in here

Const lowerPointer = 1 ' pointer into array
Const upperPointer = 2 ' pointer into array

Dim Limits(1 To NumberOfSeries, lowerPointer To upperPointer)

'modify this section to alter/add new sections
Limits(1, lowerPointer) = 101
Limits(1, upperPointer) = 150
Limits(2, lowerPointer) = 201
Limits(2, upperPointer) = 250

Dim LC As Integer ' LoopCounter

'set up at starting point
Range("C1").Select
'deal with each series in turn
For LC = LBound(Limits) To UBound(Limits)
If Val(ActiveCell) < Limits(LC, lowerPointer) Then
ActiveCell.EntireColumn.Insert
ActiveCell = Limits(LC, lowerPointer)
' or for number as text
'ActiveCell = "'" & Trim(Str(Limits(LC, lowerPointer)))
End If
Do Until UCase(Trim(ActiveCell)) = EndOfSeriesPhrase
If Val(ActiveCell.Offset(0, 1)) < Val(ActiveCell) + 1 Then
ActiveCell.Offset(0, 1).Activate
ActiveCell.EntireColumn.Insert
ActiveCell.Value = Val(ActiveCell.Offset(0, -1)) + 1
'if you need to put it in as text, use this instead
' ActiveCell.Value = "'" & Trim(Str(Val(ActiveCell.Offset(0, -1)) +
1))
If UCase(Trim(ActiveCell)) = EndOfSeriesPhrase _
Or ActiveCell = Limits(LC, upperPointer) Then
Exit Do
End If
Else
ActiveCell.Offset(0, 1).Activate
End If
Loop
'set up deal with next series
ActiveCell.Offset(0, 1).Activate
If UCase(Trim(ActiveCell)) = EndOfSeriesPhrase Then
ActiveCell.Offset(0, 1).Activate ' move over 1 more column
End If
Next ' end of LC loop
End Sub


"Arain" wrote:

What if the numbers are saved in text and the series end with word Total

for example c1 has 101 and ends at 142 then word total comes. then series
201 starts. Is there a way to implement that. Also the numbers are stored as
text should i convert them or is there a way around it.

I know i am making these changes because my boss is making these changes.

thanks

"Arain" wrote:

I have a sheet where the C1 has value 101 and goes to AF till 142. Its
missing values in between like 112 and 117. I want to add the column for the
missing value in that sheet. can someone please help. thanks.