Presenting Data from a Worksheet Database

[mharper90]

I manage a database of personnel who receive a serialized radiation monitoring device 4 times a year. In the database I track their name, their device serial number, the date of issue, date of expected collection, allowed radiation dose, current annual dose, and remaining dose allowed. I have already constructed this table of data and it works well.

In this database are 2 different qualifications of personnel. Some need their data presented on a personal page which they carry with them to track their work. I have already used the vlookup function to extract the data from the main data worksheet and populate their personalized page that gets printed. (Each person has a dedicated tab in the excel file, and I only enter their name box, which is the reference used to populate the rest of the page prior to printing).

The 2nd group of personnel are in the same database, but they don't need personal pages printed, I just need to be able to print a page of only the 2nd group of people, with most of the data organized in a nice table. So now to the question...

I'd like to add a column to my main data table that will let me differentiate if someone is in either group 1 or group 2. I'd then like to have another tab in the excel file that skims my main data table for the value of group 1 or group 2, and then displays all of the group 2 personnel in the first column of this new table, and then show certain fields of that person's data in the remaining columns of the table. (I don't want the entire row from the main data table displayed because it's too much information for the purpose of the report I need to print.)

I've looked high and low to try and figure this out myself, and I just can't find the right function. Please help lead me down the right path. Thanks!

 

[Logit]

.
Both of the following utilize Column A as the "tracking column". So for your groups #1 and #2 , you will need to design your worksheet to use Column A
for those designations or edit the code to match the column you are using.

The first project depends on the worksheets for each employee to already be created.

For both sample projects you'll need to edit the sheet names and the range designations to match your project or change your project to match the code.

If needed I can post the workbooks to the CLOUD for you to download ... and if needed I can assist you with the project as well. I am familiar with
Dosimeters, having used them in Radiology with my employees.




Sends data to own sheet (already created)

Option Explicit
Sub CopyInfo()
Dim wkSht As Worksheet
Dim cell As Range
Dim nextRow As Long
Dim lRow As Long
Dim i As Integer


Application.ScreenUpdating = False


lRow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
For Each wkSht In Sheets
    Sheets("Data").Activate
    For i = 2 To lRow
        
        If Sheets("Data").Range("A" & i).Value = wkSht.Name Then
            Sheets("Data").Activate
            nextRow = wkSht.Range("A" & Rows.Count).End(xlUp).Row + 1
            Sheets("Data").Range("A" & i).EntireRow.Copy Destination:=wkSht.Range("A" & nextRow)
       End If
       
    Next i
Next wkSht


Application.ScreenUpdating = True
End Sub

'=================================================================================


Different Project


Creates Sheets Then Copies


(In first Module)

Option Explicit
Function getSheetWithDefault(name As String, Optional wb As Excel.Workbook) As Excel.Worksheet
        If wb Is Nothing Then
            Set wb = ThisWorkbook
        End If


        If Not sheetExists(name, wb) Then
            wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count)).name = name
        End If


        Set getSheetWithDefault = wb.Sheets(name)
End Function
Function sheetExists(name As String, Optional wb As Excel.Workbook) As Boolean
        Dim sheet As Excel.Worksheet


        If wb Is Nothing Then
            Set wb = ThisWorkbook
        End If


        sheetExists = False
        For Each sheet In wb.Worksheets
            If sheet.name = name Then
                sheetExists = True
                Exit Function
            End If
        Next sheet
End Function


Sub CreateSheets()
        Dim MyCell As Range
        Dim MyRange As Range
        Dim ws As Worksheet


        Set MyRange = Sheets("ElfRegistrationReport").Range("A6") '<-- change range here where employee names are located
        Set MyRange = Range(MyRange, MyRange.End(xlDown))


        For Each MyCell In MyRange
            If Sheets(Sheets.Count).name <> MyCell.Value Then
                Set ws = getSheetWithDefault(MyCell.Value)
            End If
        
        Next MyCell
        Call CopyInfo
    End Sub


[U][B](In second Module)

[/B][/U]
Option Explicit
Sub CopyInfo()
Dim wkSht As Worksheet
Dim cell As Range
Dim nextRow As Long
Dim lRow As Long
Dim i As Integer
Dim celltxt As String
Dim celltxtval As String
Dim cellyearval As String


lRow = Sheets("ElfRegistrationReport").Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For Each wkSht In Sheets
Sheets("ElfRegistrationReport").Activate
    For i = 6 To lRow
        celltxt = Sheets("ElfRegistrationReport").Range("K" & i)
        If Sheets("ElfRegistrationReport").Range("A" & i).Value = wkSht.name Then
            Sheets("ElfRegistrationReport").Activate
            With Sheets("ElfRegistrationReport")
                If LCase(InStr(1, celltxt, "Next business day")) Then
                    celltxtval = "N2"
                Else
                If LCase(InStr(1, celltxt, "Same business day")) Then
                    celltxtval = "N1"
                End If
                End If
            End With
            With Sheets("ElfRegistrationReport")
                If LCase(InStr(1, celltxt, "3 y")) Then
                    cellyearval = "3 years"
                    Else
                        If LCase(InStr(1, celltxt, "4 y")) Then
                            cellyearval = "4 years"
                            Else
                            If LCase(InStr(1, celltxt, "5 y")) Then
                                cellyearval = "5 years"
                            End If
                        End If
                 End If
            End With
                
            wkSht.Activate
            nextRow = wkSht.Range("A" & Rows.Count).End(xlUp).Row + 1
            Sheets("ElfRegistrationReport").Range("A" & i).EntireRow.Copy Destination:=wkSht.Range("A" & nextRow)
            wkSht.Range("Q" & nextRow) = celltxtval
            wkSht.Range("R" & nextRow) = cellyearval
       End If
    Next i
Next wkSht
Application.ScreenUpdating = True
End Sub

 

[mharper90]

Thanks for the quick response! I'll have to plug it into the file and see how it works. I appreciate your offer to upload to the cloud, but because I work on a submarine, the network that contains this file wouldn't be able to also access your file on the cloud, and removable media isn't a thing for us either. I'll print this out from home and retype it at work. But I will definitely take you up on your offer for more help I'm self taught with excel, but often seek features that are well outside what I can learn on my own, so I often come here for help.

On that note, perhaps you have a solution to help me with the Group 1 people. I really don't care to ever navigate to the sheets that I print out with their personal data. I just need to print them. I strictly use the main data page to run the program. The way I use vlookup, I have to add a new person to the main data table, then duplicate a tab from my master blank tab, put their name in cell A3 to match their name in the main data table (that's the vlookup reference cell), and I also rename the tab to be just their last name. Then, when someone transfers, I delete their row from the main data table, and then I have to remember to delete their individual tab page too.

Is there a way to add a new row with the Group 1 identifier, and have that cause a chain reaction of the steps I described above? And then maybe the same if I delete their row, it would also delete their tab? If it's easier to have a main data table, and then another sheet like you already provided the formulas for, to subdivide the two categories up first before taking action on the group 1 tab things, that's fine too.

Thanks again for your help! If it comes down to it, I might try to replicate a sample file on my computer at home so that I could show you what I mean, and I could also prove/make it work at home without having the delay of running back to work.

 

[Logit]

.
If you are permitted to do so, can you post an image (no personal data showing) or the actual file (again no personal data) ?

In the meantime, I'll work on sample workbook here how I perceive it looks from your description.

 

[mharper90]

I just created a sample file (a little simpler formatting (and no real data) than my actual file, but should be workable and help convey to you the way it all works). What's the best way to share it with you? I made it in excel for Mac, since that's what I have at home. I don't mind exchanging emails, or if there's a better way, I'm willing to try a cloud or direct upload on mrexcel if possible. Thanks!

 

[Logit]

Sent a private message.

 

[Logit]

.
Here is some of the code contained in the project. The remainder can be viewed within the workbook : https://www.amazon.com/clouddrive/share/DY4gWCqnxvnJHA73dwm1nOEaKq3tjMI0fyHGmZtxGeT

Option Explicit


Private Sub CommandButton1_Click()
Dim newRow As Long
Dim ws As Worksheet


Application.ScreenUpdating = False


If Me.ComboBox1.Value = "" Or Me.TextBox2.Text = "" Or Me.TextBox3.Text = "" Or Me.TextBox4.Text = "" Or Me.TextBox5.Text = "" Or Me.TextBox6.Text = "" Then
  MsgBox "All fields must be completed. ", vbCritical, "Entry Error"
  
  Exit Sub
  
End If
    


Set ws = Worksheets("Main Data")


newRow = Application.WorksheetFunction.CountA(ws.Range("A:A")) + 1


        ws.Cells(newRow, 1).Value = Me.ComboBox1.Value
        ws.Cells(newRow, 2).Value = Me.TextBox2.Value
        ws.Cells(newRow, 3).Value = Me.TextBox3.Value
        ws.Cells(newRow, 4).Value = Me.TextBox4.Value
        ws.Cells(newRow, 6).Value = Me.TextBox5.Value
        ws.Cells(newRow, 7).Value = Me.TextBox6.Value
        
        
'autocreate new sheet for ERC employee
If ws.Cells(newRow, 1).Value = "YES" Then
Dim ans As String
        ans = Me.TextBox2.Value
        Sheets("Master Blank for ERC").Range("B1").Value = Me.TextBox2.Value
        Sheets("Master Blank for ERC").Range("B2").Value = Me.TextBox3.Value
        Sheets("Master Blank for ERC").Range("C2").Value = ws.Cells(newRow, 4).Value & "   To   " & ws.Cells(newRow, 5).Value
        Sheets("Master Blank for ERC").Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = ans
        Sheets("Master Blank for ERC").Range("B2").Value = ""
End If
        


'clear the data
Me.ComboBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = "0"
Me.ComboBox1.SetFocus


cpypste


Me.Hide


Sheets("Main Data").Activate
Sheets("Main Data").Select
Sheets("Main Data").Range("A1").Select


Application.ScreenUpdating = True
End Sub


Private Sub CommandButton2_Click()
    Me.Hide
    Me.ComboBox1.Value = ""
    Me.TextBox2.Value = ""
    Me.TextBox3.Value = ""
    Me.TextBox4.Value = ""
    Me.TextBox5.Value = ""
    Me.TextBox6.Value = "0"
        
End Sub


Private Sub UserForm_Activate()
    Me.ComboBox1.SetFocus
End Sub




Private Sub UserForm_Initialize()


' populate "Fruits_CB" Combo-Box with fruits
With Me.ComboBox1
    .Clear ' clear previous items (not to have "doubles")
    .AddItem "YES"
    .AddItem "NO"
End With


End Sub