Previous Topic Next Topic

Macro to define a interval

Solved/Closed
RWomanizer Posts 365 Registration date Monday February 7, 2011 Status Contributor Last seen September 30, 2013 - Feb 7, 2011 at 12:10 AM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Mar 9, 2011 at 08:16 AM
Hello,

i have a excel sheet of details of employee of the organisation.

in that sheet I have a column D of age. I have to define age interval for that.

the age interval is given as 18-25,25-30 is mention is the sheet2 cells A2=18, A3=25, A4=40,

Please give me the code for inserting a column E and define the interval in that in which the age of the employee falls.

Thanks in advance!


Related:

7 responses

Answer 1 / 7
RWomanizer Posts 365 Registration date Monday February 7, 2011 Status Contributor Last seen September 30, 2013 120
Feb 8, 2011 at 10:16 PM
Thanks Trowa,

I have to do this exercise regularly, I have different type group at each time.

this excel coding is work but I have to chage the interval regularly.

My concern is generate a macro which take the interval value from a sheet (e.g. in cell A1, A2 ............................ A25) and data from the same sheet (in column B:B) . and define the data in those interval values to the next column of the data (in column C:C).

Regards!
Rahul
1
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Feb 9, 2011 at 07:13 AM
You can try a user defined function to do that

some thing like this
This is based on assumption that

1. Age for range starts from Cell A2 on sheet2

2. Age are sorted in ascending order

3. if age that is being looked up, is less than the minimum age, then you want to return "<" (minimum age)

4. if age that is being looked up, is more or equal to the maximum age, then you want to return ">" (maximum age)

In order to use the function, you would make a call like
=getAgeRange(a2) 


Public Function getAgeRange(rngAgeCell As Range) As String

   Dim lFirstRow     As Long
   Dim sAnswer       As String
   
   On Error Resume Next
   
   If (IsError(Application.WorksheetFunction.Match(rngAgeCell.Value, Sheets("Sheet2").Range("A:A"), 1))) _
   Then
      sAnswer = "<" & Sheets("Sheet2").Cells(2, "A")
      Err.Clear
      On Error GoTo 0
   Else
      Err.Clear
      On Error GoTo 0
      lFirstRow = Application.WorksheetFunction.Match(rngAgeCell, Sheets("Sheet2").Range("A:A"), 1)
      
      If (Sheets("Sheet2").Cells(lFirstRow + 1, "A") = vbNullString) _
      Then
         sAnswer = ">=" & Sheets("Sheet2").Cells(lFirstRow, "A")
      Else
         sAnswer = Sheets("Sheet2").Cells(lFirstRow, "A") & " - " & Sheets("Sheet2").Cells(lFirstRow + 1, "A")
      End If
   End If
   getAgeRange = sAnswer
   
End Function
0
Answer 2 / 7
RWomanizer Posts 365 Registration date Monday February 7, 2011 Status Contributor Last seen September 30, 2013 120
Feb 10, 2011 at 11:35 PM
Please have a look on what my concern is all about:

I have a workbook in which sheet1 has data the column are like this:

A: S.N. B: Name C: Date Of Birth D: Age E: Gender F:Higher Education and so on

and in sheet2 I have the interval. like this

Column :A
Row 1: Intervals
Row 2: 0
Row 3: 21
Row 4: 31
Row 5: 41
Row 6: 51
the interval may be is more than five, some times its can go up to 15.

I want to assign macros to a button in sheet1 by click on that I got following:
1) A new column after column D title Age Group. (new column E).
2) In this column, the output is the intervals which are defined in sheet2. (as the your defined function do)

Thanks!
1
Answer 3 / 7
RWomanizer Posts 365 Registration date Monday February 7, 2011 Status Contributor Last seen September 30, 2013 120
Feb 11, 2011 at 01:58 AM
Hi rizvisa!

after considering lots of macros along with your function, I am now able to get a new code.

its working but takes a lot of time to execute,

code is 

Sub interval()
Dim I As Long
Dim j As Long
Application.ScreenUpdating = False

i = 1
For j = 1 To 99999
    If Cells(i, j) = "" Then
    I = I + 1
    j = 0
    Else
        If Cells(i, j) = "AGE" Then
        Cells(i, j + 1).EntireColumn.Insert
        Cells(i, j + 1).Value = "Interval"
        Exit For
        End If
    End If
Next j
i = I + 1
Do Until Trim(Cells(i, j)) = ""
    Cells(i, j + 1).Value = getRange(Cells(i, j))
    I = I + 1
Loop
Application.ScreenUpdating = true

End Sub

Public Function getRange(rngCell As range) As String

   Dim lFirstRow     As Long
   Dim sAnswer       As String
   
   On Error Resume Next
   
   If (IsError(Application.WorksheetFunction.Match(rngCell.Value, Sheets("Range").range("A:A"), 1))) _
   Then
      sAnswer = "<=" & Sheets("Range").range("A2") - 1
      Err.Clear
      On Error GoTo 0
   Else
      Err.Clear
      On Error GoTo 0
      lFirstRow = Application.WorksheetFunction.Match(rngCell, Sheets("Range").range("A:A"), 1)
      
      If (Sheets("Range").Cells(lFirstRow + 1, "A") = vbNullString) _
      Then
         sAnswer = ">" & Sheets("Range").Cells(lFirstRow, "A") - 1
                  
      Else
         sAnswer = Sheets("Range").Cells(lFirstRow, "A") & " - " & Sheets("Range").Cells(lFirstRow + 1, "A") - 1
         
      End If
   End If
   getRange = sAnswer
   
End Function


and I have 15000 rows it will take nearly 15 min to compile.

kindly help me out! by proper coding.
1
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Feb 11, 2011 at 05:59 AM
I dont understand what you are trying to do in the code. so hard to tell u what to do.

But what also I dont get it is
Since you say age range is in column "E", insert a new column after E
in the first cell write
=getRange (E1)
and drag is all the way down.
If you dont want the formula to remain there. you can then use copy and paste-special and paste as values
0
Answer 4 / 7
RWomanizer Posts 365 Registration date Monday February 7, 2011 Status Contributor Last seen September 30, 2013 120
Feb 13, 2011 at 11:32 PM
This code is work like this way:

first it search a cell having value "=AGE". (suppose it is in cell "D1")

then it insert a coloumn after that cell with header "AGE INTERVAL". (Column E)

now the values in coloumn E are coming from the getRange function.

i used do loop for this which take too much time to execute.

can you suggest any other way to by the process could be simple and not take too much time.

Hope you will be understand.
1
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Feb 17, 2011 at 08:18 AM
OK, what if there is no column named "AGE". then ?

It the column is always there, then other question is that why cant you have a permanent column after age. In that column you can put the formula on the first usable row and then simply double click to let it fill till the last used row . What is the resistance or issue in this approach?
0

Didn't find the answer you are looking for?

Ask a question
Answer 5 / 7
RWomanizer Posts 365 Registration date Monday February 7, 2011 Status Contributor Last seen September 30, 2013 120
Mar 9, 2011 at 06:53 AM
hi Riz,

I comes to know about lookup function, we can use this for defining interval.
by this we need not to open the workbook in which the Function is defined for interval.

we just have to define age in decending order and put corrosponding interval in front of them like:

Column
K L
0 below 18 years
18 18-25 years
26 26-35 years
36 36-50 years
51 Above 51 years

and use function
=Lookup(A2,K:K,L:L)

I am right or there is any issue to using lookup.
1
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Mar 9, 2011 at 08:16 AM
Nope, I dont think there would be any issue
0
Answer 6 / 7
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Feb 7, 2011 at 09:23 AM
RWomanizer,

How many groups do you have?

Can this work for you?: 

19	=IF(A1>=56,"56-60",IF(A1>=51,"51-55",IF(A1>=46,"46-50",IF(A1>=41,"41-45",IF(A1>=36,"36-40",IF(A1>=31,"31-35",IF(A1>=26,"26-30","18-25")))))))
26	=IF(A2>=56,"56-60",IF(A2>=51,"51-55",IF(A2>=46,"46-50",IF(A2>=41,"41-45",IF(A2>=36,"36-40",IF(A2>=31,"31-35",IF(A2>=26,"26-30","18-25")))))))
33	=IF(A3>=56,"56-60",IF(A3>=51,"51-55",IF(A3>=46,"46-50",IF(A3>=41,"41-45",IF(A3>=36,"36-40",IF(A3>=31,"31-35",IF(A3>=26,"26-30","18-25")))))))
37	=IF(A4>=56,"56-60",IF(A4>=51,"51-55",IF(A4>=46,"46-50",IF(A4>=41,"41-45",IF(A4>=36,"36-40",IF(A4>=31,"31-35",IF(A4>=26,"26-30","18-25")))))))
42	=IF(A5>=56,"56-60",IF(A5>=51,"51-55",IF(A5>=46,"46-50",IF(A5>=41,"41-45",IF(A5>=36,"36-40",IF(A5>=31,"31-35",IF(A5>=26,"26-30","18-25")))))))
49	=IF(A6>=56,"56-60",IF(A6>=51,"51-55",IF(A6>=46,"46-50",IF(A6>=41,"41-45",IF(A6>=36,"36-40",IF(A6>=31,"31-35",IF(A6>=26,"26-30","18-25")))))))
55	=IF(A7>=56,"56-60",IF(A7>=51,"51-55",IF(A7>=46,"46-50",IF(A7>=41,"41-45",IF(A7>=36,"36-40",IF(A7>=31,"31-35",IF(A7>=26,"26-30","18-25")))))))
56	=IF(A8>=56,"56-60",IF(A8>=51,"51-55",IF(A8>=46,"46-50",IF(A8>=41,"41-45",IF(A8>=36,"36-40",IF(A8>=31,"31-35",IF(A8>=26,"26-30","18-25")))))))


Best regards,
Trowa
0
Answer 7 / 7
RWomanizer Posts 365 Registration date Monday February 7, 2011 Status Contributor Last seen September 30, 2013 120
Feb 10, 2011 at 04:11 AM
Thanks Rizvisa1!

The function is working.

but want to do this by macros, I am new for vb so I am not able to run this function using macros.

Can you please give me macro coding for this.

Thanks again!
Rahul
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Feb 10, 2011 at 04:34 AM
function is a macro too.
I guess what you mean to say is that you want to use via a sub routine, instead of making a call from sheet just like any other function like NOW()

not knowing how u r planning to use. what I can suggest is that use this as a normal function, then use macro recorder to see how it is being used and then you can fit it into you macro
0

Similar discussions

Code for macro that conditionally inserts rows
bfleming -
bfleming -

4 responses
Execute Macro On Calculated Cell change
Notar -
rizvisa1 -

5 responses