macro or function help needed for adding columns for values missin

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

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.
 
If it ends at 142 and is only in AF, possibly others are missing also. This
code will start at D1 (next to C1) and check to see if value in current cell
is 1 greater than in cell to its left. If not, then will insert a column and
put in the proper value. Continues until it hits an empty cell in row 1. In
the end you will have the entire sequence C1=101 ... AR1 = 142

Sub InsertColumnsAndValues()
'must be on sheet with data before running
'must be no empty cells in row 1 from
'start of series at C1 to end of series (AF1?)
'
'Practice with copy of your worksheet first!
'
Range("D1").Select ' not a mistake!
Do While Not (IsEmpty(ActiveCell))
If ActiveCell.Value <> ActiveCell.Offset(0, -1) + 1 Then
Selection.EntireColumn.Insert
ActiveCell.Value = ActiveCell.Offset(0, -1) + 1
End If
ActiveCell.Offset(0, 1).Activate
Loop
End Sub
 
Well it works but it keeps going the range of that value is 101 to 150. After
it has added missing columns till 150 a it should stop and then check for
201value to 250. and the missing cloumns for the number between. 101 to 150
stop 201 to 250 stop. The series that follows right after 150 is 201 in the
sheet. I really appreciate your help.
 
You didn't say anything about any values past 142 in your original post.
Now, are there any values after 250? And are 201-250 still in row 1?
 
Use this instead then, and I've set it up so that if there are other series
beyond the 201-250, you can simply cut and paste one segment of the code and
insert it, change 2 values, and deal with as many series as your sheet can
hold.

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

Dim LowerLimit As Integer
Dim UpperLimit As Integer

'deal with first series
Range("C1").Select
LowerLimit = 101
UpperLimit = 150
If ActiveCell <> LowerLimit Then
ActiveCell.EntireColumn.Insert
ActiveCell = LowerLimit
End If
Do Until ActiveCell = UpperLimit
If ActiveCell.Offset(0, 1) <> ActiveCell + 1 Then
ActiveCell.Offset(0, 1).Activate
ActiveCell.EntireColumn.Insert
ActiveCell.Value = ActiveCell.Offset(0, -1) + 1
If ActiveCell = UpperLimit Then
Exit Do
End If
Else
ActiveCell.Offset(0, 1).Activate
End If
Loop
'deal with second series
ActiveCell.Offset(0, 1).Activate

'*****
LowerLimit = 201
UpperLimit = 250
'in case series goes like
' ...149 150 202 203...
If ActiveCell <> LowerLimit Then
ActiveCell.EntireColumn.Insert
ActiveCell = LowerLimit
End If
Do Until ActiveCell = UpperLimit
If ActiveCell.Offset(0, 1) <> ActiveCell + 1 Then
ActiveCell.Offset(0, 1).Activate
ActiveCell.EntireColumn.Insert
ActiveCell.Value = ActiveCell.Offset(0, -1) + 1
If ActiveCell = UpperLimit Then
Exit Do
End If
Else
ActiveCell.Offset(0, 1).Activate
End If
Loop
ActiveCell.Offset(0, 1).Activate
'*****
'if you have more series after 201-250
'just copy the code segment between '***** above and
'paste below and change LowerLimit and UpperLimit values
'repeat for all series you have

End Sub
 
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
 
Tell your boss if he keeps moving the target, I'm going to start charging him
about $75/hour to keep hitting it in the new location. At those rates he'll
probably decide that it's best to do a well thought out design of the project
before handing it off to someone to do, and redo, and redo, and redo.

But I can sympathize - Yes, I can deal with ending when we hit the word
Total, and I can deal with entries in the cells being either text or a real
number. I presume our limits are still 101-150, 201-250, etc? I'll put up
code to deal with that shortly. If he comes up with more changes - let me
know here and I'll try to hold my tongue and keep from getting you fired.
 
Try this - notice the new Const value - change that to whatever phrase you
decide to use at the end of each sequence. In the code it needs to be all
UPPERcase, although it doesn't matter how you type it in on the worksheet.
Also, the last sequence (as the 201-250 so far) needs to end with that
phrase. This code will handle the entries whether they're real numbers or
numbers as text, and there is optional code in it, now commented out to add
new numbers to the sequence as numbers as text vs real numbers.

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

Dim LowerLimit As Integer
Dim UpperLimit As Integer
Const EndOfSeriesPhrase = "TOTAL" ' use all caps in here

'deal with first series
Range("C1").Select
LowerLimit = 101
UpperLimit = 150
If ActiveCell <> LowerLimit Then
ActiveCell.EntireColumn.Insert
ActiveCell = LowerLimit
' or for number as text
'ActiveCell = "'" & Trim(Str(LowerLimit))
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 = UpperLimit Then
Exit Do
End If
Else
ActiveCell.Offset(0, 1).Activate
End If
Loop
'deal with second series
ActiveCell.Offset(0, 1).Activate
If UCase(Trim(ActiveCell)) = EndOfSeriesPhrase Then
ActiveCell.Offset(0, 1).Activate ' move over 1 more column
End If
'*****
LowerLimit = 201
UpperLimit = 250
'in case series goes like
' ...149 150 202 203...
If Val(ActiveCell) <> LowerLimit Then
ActiveCell.EntireColumn.Insert
ActiveCell = LowerLimit
' or for number as text
'ActiveCell = "'" & Trim(Str(LowerLimit))
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 = UpperLimit Then
Exit Do
End If
Else
ActiveCell.Offset(0, 1).Activate
End If
Loop
ActiveCell.Offset(0, 1).Activate
If UCase(Trim(ActiveCell)) = EndOfSeriesPhrase Then
ActiveCell.Offset(0, 1).Activate ' move over 1 more column
End If
'*****
'if you have more series after 201-250
'just copy the code segment between '***** above and
'paste below and change LowerLimit and UpperLimit values
'repeat for all series you have

End Sub
 
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
 
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.
 
Glad it's holding up to the strain. Only potential problem I see with it is
that of too many sequences - I didn't check to see if you were about to
create too many columns or move into a column beyond the last one in your
version of Excel. So if you get into either of those situations, you'll get
the pleasure of watching a VB routine crash rather dramatically.

Recording and modifying macros is a good way to start learning VBA for Excel
(or other applications using it). If nothing else they teach you the/a
proper syntax and reference structure for accessing the various objects in
the application like worksheets, cells, charts, etc. Most people find it
tough to modify them to work as this one has to - repeating process with
varied values across a broader range of a worksheet or other object (like a
table in Access or within a paragraph in Word).

Keeping the boss happy, that's what it's all about, 'cause that kind of
helps assure that they include you in next week's payroll list :-) Enjoy.
 
Back
Top