Admissions Spreadsheet: Simple method to populate data?

B

BC_George

New member
Joined
Sep 3, 2015
Messages
2
Reaction score
0
Points
0
Location
Vancouver, BC
Hi all

I work in hospital admin and have a problem that I think somebody here will be able to solve really easily. For context: admitting staff without IT skills are copying and pasting numerous data fields into 1 worksheet which results in crazy formatting issues and is impossible to control.

We need a simple user-friendly system for hospital admissions; several fields that the clerk can fill in and which then populate into another tab on the same spreadsheet. This will keep the admin staff away from having to navigate around large amounts of data.

When a new patient is admitted and their data is entered in the first worksheet, I need it to automatically populate into the next blank line on the second worksheet. I thought this would be easy to figure out but can't find anything on forums & help functions that seems to fit.

I'm using Excel 2010; don't ask why we don't use Access. It's a long and frustrating story. Any help is massively appreciated!
 

Attachments

  • Admissions.xlsx
    13.9 KB · Views: 17
Copy data to new row to another Sheet

Maybe you can help this VBA code (I am not the author)

Code: 
Sub CopyData()

Dim rw As Long
Dim cl As Integer
Dim Dest As Range

'Sets the first column for the entry
cl = 1 ' A column
'Find the first blank row in column A
rw = ActiveWorkbook.Sheets("Data").Cells(65535, cl).End(xlUp).Row + 1
'  You may change where be copied
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl)  ' Where is destination1
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("B11")  ' Entry first data
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 1) ' Where is destination2
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("E11") ' Entry second data
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 2)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("B13")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 3)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("E13")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 4)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("B16")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 5)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("E16")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 6)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("B18")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 7)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("B21")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 8)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("E21")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 9)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("B26")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 10)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("D26")
End Sub

See attach
 

Attachments

  • bc_george_navic.xlsm
    23.3 KB · Views: 17
there's always more than one way....
Code: 
Sub AnotherWay()

    Dim writerow As Long
    Dim str As String
    
With Sheets("Dashboard")
    'get data in correct order
    str = [b11] & "|" & [e11] & "|" & [b13] & "|" & [e13] & "|" & [b16] & "|" & [e16] & "|" & _
          [b18] & "|" & [b21] & "|" & [e21] & "|" & [b26] & "|" & [d26]
End With

With Sheets("Data")
    'write data
    writerow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Cells(writerow, 1).Resize(1, 11).Value = Split(str, "|")
End With
    
With Sheets("Dashboard")
    'clear data
    [b11] = "": [e11] = "": [b13] = "": [e13] = "": [b16] = "": [e16] = ""
    [b18] = "": [b21] = "": [e21] = "": [b26] = "": [d26] = ""
End With

End Sub
 
Thank you !!!!

Thank you SO much navic and NoS - this is perfect! I can't tell you how grateful I am




navic said:
Maybe you can help this VBA code (I am not the author)

Code: 
Sub CopyData()

Dim rw As Long
Dim cl As Integer
Dim Dest As Range

'Sets the first column for the entry
cl = 1 ' A column
'Find the first blank row in column A
rw = ActiveWorkbook.Sheets("Data").Cells(65535, cl).End(xlUp).Row + 1
'  You may change where be copied
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl)  ' Where is destination1
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("B11")  ' Entry first data
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 1) ' Where is destination2
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("E11") ' Entry second data
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 2)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("B13")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 3)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("E13")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 4)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("B16")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 5)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("E16")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 6)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("B18")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 7)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("B21")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 8)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("E21")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 9)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("B26")
Set Dest = ActiveWorkbook.Sheets("Data").Cells(rw, cl + 10)
Dest.Value = ActiveWorkbook.Sheets("Dashboard").Range("D26")
End Sub

See attach
Click to expand...
 
You must log in or register to reply here.
Back
Top