Multiple Criteria VBA with Action

seanjon

New Member
Joined
Dec 23, 2017
Messages
15
Office Version
  1. 2019
Platform
  1. Windows
Good day.



I need expert level assistance. I am trying to create a VBA controlled information sorting and display for the training of my team members. I just manually entered who is qualified in what and it took me the better part of a day. With 22 employees and over 200 tasks, updating this monthly is too time consuming. Here is what I am looking at:



Sheet 2 (RAW DATA) lists all the employees and all the training they are certified in, within 90 days of going overdue, and decertified in.

Sheet 1 (TEAM TRAINING) compiles all of this to a 1 stop shop for my manager and I to look at the entire team.

I want the VBA to look up each course code, (Column A) Reference the Employees (Row C1-F1) and go to Sheet 2 to see if they have the code 100 or 200 in Column F. If so, I want an ‘X’ in the corresponding box under their name for that course code back on Sheet 1.

I have included an example workbook with the names and the courses changed

Thank you very much.
 

Attachments

  • Sheet 1.PNG
    Sheet 1.PNG
    14.1 KB · Views: 34
  • Sheet 2.PNG
    Sheet 2.PNG
    19.2 KB · Views: 29

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
There is lots of room for improvement in this code. There should be a better way to determine when to stop the While loops. For example, checking for "" to stop is probably not the best. There is a chance it could lead to an infinite loop.

And once you get a match you should stop looping. This code loops through all of the cells even after a match is found. If you have a lot more data, it could run a very long time for no reason. Add a flag when you find what you are looking and in the While loop add a AND not found.

It loops through each line on the TEAM TRAINING sheet. It searches for course in column A in the RAW DATA column D. When it finds the code, it checks for 100 or 200. If it passes that criteria it takes the name and searches for it in TEAM TRAINING row 1

VBA Code:
Sub Training_summary()

    Dim num_training_rows As Long
    Dim training As Long
    Dim raw_row As Long
    Dim name_column As Long
    
    Dim current_course As String
    Dim learner As String
    Dim code As String

    num_training_rows = Worksheets("TEAM TRAINING").Cells(Rows.Count, 1).End(xlUp).Row          ' How many rows are used on the TREAM TRAINING sheet
    
    raw_row = 3                                                                                 ' The raw data starts in row 3
    For training = 2 To num_training_rows                                                       ' Loop through TEAM TRAINING rows
        current_course = Worksheets("TEAM TRAINING").Cells(training, 1).Value                   ' What course are we looking for
        While (Worksheets("RAW DATA").Cells(raw_row, 3).Value <> "")                            ' Loop through the RAW DATA until we hit a empty row (assume empty is the last row)
            code = Worksheets("RAW DATA").Cells(raw_row, 4).Value                               ' Get a RAW DATA code
            If current_course = code Then                                                       ' Does it match the course we are looking for?
                If ((Worksheets("RAW DATA").Cells(raw_row, 6).Value = 100) Or _
                    (Worksheets("RAW DATA").Cells(raw_row, 6).Value = 200)) Then                ' Does it meet the status criteria
                    learner = Worksheets("RAW DATA").Cells(raw_row, 3).Value                    ' get the name
                    name_column = 3                                                             ' the names start in column C
                    While Worksheets("TEAM TRAINING").Cells(1, name_column).Value <> ""         ' loop through all names in row 1
                        If Worksheets("TEAM TRAINING").Cells(1, name_column).Value = learner Then   ' does name match the learner
                            Worksheets("TEAM TRAINING").Cells(training, name_column).Value = "X"    ' put an X in the cell
                        End If
                        name_column = name_column + 1                                           'move to the next name
                    Wend
                 End If
            End If
            raw_row = raw_row + 1                                                               ' next row of the raw data
        Wend
        raw_row = 3                                                                             ' start over at the top for the next code
    Next
    
End Sub
 
Upvote 1
Solution
There is lots of room for improvement in this code. There should be a better way to determine when to stop the While loops. For example, checking for "" to stop is probably not the best. There is a chance it could lead to an infinite loop.

And once you get a match you should stop looping. This code loops through all of the cells even after a match is found. If you have a lot more data, it could run a very long time for no reason. Add a flag when you find what you are looking and in the While loop add a AND not found.

It loops through each line on the TEAM TRAINING sheet. It searches for course in column A in the RAW DATA column D. When it finds the code, it checks for 100 or 200. If it passes that criteria it takes the name and searches for it in TEAM TRAINING row 1

VBA Code:
Sub Training_summary()

    Dim num_training_rows As Long
    Dim training As Long
    Dim raw_row As Long
    Dim name_column As Long
   
    Dim current_course As String
    Dim learner As String
    Dim code As String

    num_training_rows = Worksheets("TEAM TRAINING").Cells(Rows.Count, 1).End(xlUp).Row          ' How many rows are used on the TREAM TRAINING sheet
   
    raw_row = 3                                                                                 ' The raw data starts in row 3
    For training = 2 To num_training_rows                                                       ' Loop through TEAM TRAINING rows
        current_course = Worksheets("TEAM TRAINING").Cells(training, 1).Value                   ' What course are we looking for
        While (Worksheets("RAW DATA").Cells(raw_row, 3).Value <> "")                            ' Loop through the RAW DATA until we hit a empty row (assume empty is the last row)
            code = Worksheets("RAW DATA").Cells(raw_row, 4).Value                               ' Get a RAW DATA code
            If current_course = code Then                                                       ' Does it match the course we are looking for?
                If ((Worksheets("RAW DATA").Cells(raw_row, 6).Value = 100) Or _
                    (Worksheets("RAW DATA").Cells(raw_row, 6).Value = 200)) Then                ' Does it meet the status criteria
                    learner = Worksheets("RAW DATA").Cells(raw_row, 3).Value                    ' get the name
                    name_column = 3                                                             ' the names start in column C
                    While Worksheets("TEAM TRAINING").Cells(1, name_column).Value <> ""         ' loop through all names in row 1
                        If Worksheets("TEAM TRAINING").Cells(1, name_column).Value = learner Then   ' does name match the learner
                            Worksheets("TEAM TRAINING").Cells(training, name_column).Value = "X"    ' put an X in the cell
                        End If
                        name_column = name_column + 1                                           'move to the next name
                    Wend
                 End If
            End If
            raw_row = raw_row + 1                                                               ' next row of the raw data
        Wend
        raw_row = 3                                                                             ' start over at the top for the next code
    Next
   
End Sub
You are absolutely amazing! Worked perfectly - I cannot thank you enough!!!
 
Upvote 0

Forum statistics

Threads
1,223,897
Messages
6,175,271
Members
452,628
Latest member
dd2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top