# Presenting Data from a Worksheet Database

#### mharper90

##### Board Regular
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!

### Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

#### Logit

##### Well-known Member
.
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)

Code:
``````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)

Code:
``````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
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

##### Board Regular
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

##### Well-known Member
.
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

##### Board Regular

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

##### Well-known Member
Sent a private message.

#### Logit

##### Well-known Member
.
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

Code:
``````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")
End With

End Sub``````

Replies
1
Views
50
Replies
0
Views
127
Replies
5
Views
227
Replies
0
Views
84
Replies
0
Views
110

1,130,201
Messages
5,640,819
Members
417,168
Latest member
StumpoC

### 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.

### Which adblocker are you using?

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

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