VB Macro Solution for searching specifics worksheets and entering data

[Stephen1313]

I am new to MACROs and VB. However, I am building a master personnel data base with automations. In the core worksheet we will input data metrics regarding performance etc. In four other worksheets that break the students down by their class and each year the data migrates (freshmen to sophomore, sophomore to junior etc.) I have already written a macro for the end of the year that transitions the data from one worksheet to another. I have come to the conclusion though that this will likely break any cell reference links if I were to establish them to pull data entered on the master sheet that is referenced in the breakout class sheets.

So here is conceptually what I am trying to do. On the master "Student Data" sheet, it is organized by student last names contained in column A4 and below. Fitness Score data is one of the referenced data points and will be entered in column N. I would like to write a macro that when executes first determines whether to execute the search and subsequent data entry only if the value in cell N4 greater than or equal to 270. If true it searches for the last name contained in the Master student Data sheet A4 cell across the "Freshmen", "Sophomore", "Junior", and "Senior" worksheets only until it finds the student. once that name is found enters the integer 1 based on a positional reference from the active cell where the name was found(these columns do not change. If possible the positional reference could be linked to an if statement like If(AND(N4>=270,N4<280,119,IF(AND(N4>=280,N4<290,110,IF(AND(N4>=290,N4<300,101,92)))))) would it then be possible to loop this for the remaining names in the A4 column and fitness scores in the N4 columns of the master student data sheet?

Thanks for any help or thoughts!

 

[JLGWhiz]

Do your students have such unique names that the same last name would not appear in "Senior" and some other worksheet? If Smith, Joe is a senior and Smith, Bob is aJunior and Smith, Sally is A Freshman, how would vba know which one it was looking for when searching by last name only. Do the students not have an ID number that can make them unique? Are first names used and , if so, what column would they be in? Also, do you need the formula or would a calculation by code do just as well to evealuate the values in column N of Student Data>

 

[Stephen1313]

JLGWhiz,

Great point. We actually do have two sibling students, one is a freshman and one is a senior so that would present an issue. Column B in both sheets contain first names. Would it be possible to have the VB match both the values in column A and B from the master data sheet against the other sheets to determine a unique match and then run the remaining sequence. With regards to your question about the values in column N. I am not sure the CODE function would achieve the desired results, or at least base on my preliminary understanding that when used returns a numerical value for the first value in the string for that cell. The data in column N will be a range of scores that can be anywhere from 0 to 350. The sample formula I provided was my attempt to sort out the scores according to range scales that equate to fitness awards for scores within the given ranges and if they fell 269 or below ignored and move on to the next cell. These fitness award ranges equate to award columns in the breakdown sheets (freshmen, sophomore. etc). Example: A score of 271 would earn the student a bronze award which is annotated under the "DM" column in each of the breakout sheets (Freshmen, sophomore, junior, senior) since these columns never change I figured it would be ok to use positional references (ie. 119 positions from "Sheet Freshmen" cell A4). But I am not a VB master or even novice so I don't know if this would be the best approach.

 

[JLGWhiz]

This uses a select case statement to do what your formula does. I was not sure where you wanted the results displayed so I just set it up to be in the cell to the right of the 1 that was entered in the first empty column to the right of your original database in the class sheets. You can test this on a copy of your file to see if it is what you are looking for.

Sub t()
Dim sh As Worksheet, ary() As Variant
Dim fn As Range, lc As Long, adr As String
Set sh = Sheets("Student Data")
ary = Array("Senior", "Junior", "Sophomore", "Freshmen")
    With sh
        For Each c In .Range("A4", .Cells(Rows.Count, 1).End(xlUp))
            For i = LBound(ary) To UBound(ary)
                With Sheets(ary(i))
                    Set fn = .Range("A:A").Find(c.Value, , xlValues, xlWhole)
                        If Not fn Is Nothing Then
                            adr = fn.Address
                            Do
                                If LCase(fn.Offset(, 1)) = LCase(c.Offset(, 1)) Then
                                    .Cells(fn.Row, Columns.Count).End(xlToLeft).Offset(, 1) = 1
                                    
                                    Select Case sh.Cells(c.Row, "N").Value
                                        Case 270 To 279
                                            .Cells(fn.Row, Columns.Count).End(xlToLeft).Offset(, 1) = 119
                                        Case 280 To 289
                                            .Cells(fn.Row, Columns.Count).End(xlToLeft).Offset(, 1) = 110
                                        Case 290 To 299
                                            .Cells(fn.Row, Columns.Count).End(xlToLeft).Offset(, 1) = 101
                                        Case Is >= 300
                                            .Cells(fn.Row, Columns.Count).End(xlToLeft).Offset(, 1) = 92
                                    End Select
                                    Exit For
                                End If
                                Set fn = .Range("A:A").FindNext(fn)
                            Loop While fn.Address <> adr
                        End If
                End With
            Next
        Next
    End With
End Sub

 

[Stephen1313]

As I mentioned I am by no means a pro at this so I apologize. So this seems pretty close. Some initial issues are annotated below and the version of the code where I made some modifications based on my sheet names.

1. When I run the MACRO for each case it drops the value 1 now 1 columns to the right of the last data entry in that row (I changed the offset to 1 in the code below for testing simplicity sake). I noted initially that the commands .Cells(fn.Row, Columns.Count).End(xlToLeft).Offset(, 1) = 1. Searches for the last entry in that row and then conducts the offset function. However, this presents a problem as there will be many award data entries potentially between the Column A and the destination column which will be fixed. Is there a way to modify the output response to a cell exactly 119 columns right of fn.row column A in the arrayed sheet that the match was found in?

2. I believe the code lines below represent an action taken if data falls outside of the cases below it that contain the data ranges for scores. The issue I see is when I run the code two data entries populate which is perplexing to me. Please reference the MSIV Award Tracker picture which shows the output after running the code if my explanation is unclear, please ignore the date as that cell is formatted for dates and transformed the output.
If LCase(fn.Offset(, 1)) = LCase(c.Offset(, 1)) Then
.Cells(fn.Row, Columns.Count).End(xlToLeft).Offset(, 1) = 1


I have added snapshots of the CDT Data sheet so you can see the structure and the MS IV Award Tracker sheet which is one of the array sheets from your code and potentially where data would go if the search criteria is met.

Thanks again!

Steve


Sub t()
Dim sh As Worksheet, ary() As Variant
Dim fn As Range, lc As Long, adr As String
Set sh = Sheets("CDT Data")
ary = Array("MS IV Award Tracker", "MS III Award Tracker", "MS II Award Tracker", "MS I Award Tracker")
With sh
For Each c In .Range("A4", .Cells(Rows.Count, 1).End(xlUp))
For i = LBound(ary) To UBound(ary)
With Sheets(ary(i))
Set fn = .Range("A:A").Find(c.Value, , xlValues, xlWhole)
If Not fn Is Nothing Then
adr = fn.Address
Do
If LCase(fn.Offset(, 1)) = LCase(c.Offset(, 1)) Then
.Cells(fn.Row, Columns.Count).End(xlToLeft).Offset(, 1) = 1

Select Case sh.Cells(c.Row, "N").Value
Case 270 To 279
.Cells(fn.Row, Columns.Count).End(xlToLeft).Offset(, 1) = 1
Case 280 To 289
.Cells(fn.Row, Columns.Count).End(xlToLeft).Offset(, 1) = 1
Case 290 To 299
.Cells(fn.Row, Columns.Count).End(xlToLeft).Offset(, 1) = 1
Case Is >= 300
.Cells(fn.Row, Columns.Count).End(xlToLeft).Offset(, 1) = 1
End Select
Exit For
End If
Set fn = .Range("A:A").FindNext(fn)
Loop While fn.Address <> adr
End If
End With
Next
Next
End With
End Sub

 

[JLGWhiz]

Well, the way this works is that you tell us where you want the data entered on the sheet and then we offer suggestions on how to get it to display in those places. That item was very vague in the OP. The sheets described in the OP do not match the images in Post #5, so I am now completely confused as to what your objective is. The code offered looks at four worksheets, searching column A for a match and then comparing column B data on any matched item for column A. If all matches, it then finds the last column for that row and enters a 1, then enters the score in the next column to the right based on the value found in column N of the data sheet. It is a complex arrangement of code loops and algorithm. I will consider your comments and if I can determine a way to alter the code to fit the sheet layouts, I will post back.

 

[JLGWhiz]

Please answer these three questions explicitly.
1. Do you need both the 1 and the score entries? If so,
2. In which column do you want the 1 to appear?
3. In which column do you want the score to appear?

It is easiy enough to just put the score in column 120, which would be 119 columns right of column A. but I want to be sure that is where you want the data.

 

[Stephen1313]

Please answer these three questions explicitly.
1. Do you need both the 1 and the score entries? If so,
2. In which column do you want the 1 to appear?
3. In which column do you want the score to appear?

It is easiy enough to just put the score in column 120, which would be 119 columns right of column A. but I want to be sure that is where you want the data.

JLGWhiz,

First, I greatly appreciate your help and apologize for the confusion initially I was trying to explain in the most generic terms possible.
1. I do not need the score entries from column N as an output. Those scores are only used to determine which award type the student will receive based on the ranges (270-279, 280-289, 290-299, and 300 or above). If they earn one of these awards the output should be a 1 in the respective column (offset for each range listed bellow) on which ever "MS 'X' Award Tracker" Sheet they are found on.
Givens:
-All "MS Award Tracker" Sheets are formatted exactly the same with regard to columns across.
-Student Last names and first names respectively are contained in Columns A4 and B4 and below in all "MS Award Tracker" worksheets.

-If the Score from Column N is 269 or below skip to the next student and score as they will not earn an award
-If the students Score from Column N falls within the 270-279 range the value "1" should be offset from the A column in the row the student name was found, 119 spaces right
-If the Score from Column N falls within the 280-289 range the value "1" should be offset from the A column in the row the student name was found, 120 spaces right
-If the Score from Column N falls within the 290-299 range the value "1" should be offset from the A column in the row the student name was found, 121 spaces right
-If the Score from Column N falls within the 300 range the value "1" should be offset from the A column in the row the student name was found, 122 spaces right

Hopefully this better conveys what I am trying to achieve. Again I appreciate your time and help!!

 

[JLGWhiz]

Sub t()
Dim sh As Worksheet, ary() As Variant
Dim fn As Range, lc As Long, adr As String
Set sh = Sheets("CDT Data")
ary = Array("MS IV Award Tracker", "MS III Award Tracker", "MS II Award Tracker", "MS I Award Tracker")
    With sh
        For Each c In .Range("A4", .Cells(Rows.Count, 1).End(xlUp))
            For i = LBound(ary) To UBound(ary)
                With Sheets(ary(i))
                    Set fn = .Range("A:A").Find(c.Value, , xlValues, xlWhole)
                        If Not fn Is Nothing Then
                            adr = fn.Address
                            Do
                                If LCase(fn.Offset(, 1)) = LCase(c.Offset(, 1)) Then
                                    Select Case sh.Cells(c.Row, "N").Value
                                        Case 270 To 279
                                            fn.Offset(, 119) = 1
                                        Case 280 To 289
                                            fn.Offset(, 120) = 1
                                        Case 290 To 299
                                            fn.Offset(, 121) = 1
                                        Case Is >= 300
                                            fn.Offset(, 122) = 1
                                    End Select
                                    Exit For
                                End If
                                Set fn = .Range("A:A").FindNext(fn)
                            Loop While fn.Address <> adr
                        End If
                End With
            Next
        Next
    End With
End Sub

 

[Stephen1313]

JLGWhiz,

After some initial tests I think this is the solution!! Thank you so much again!