Pasting specific data on a new sheet with macro - excel

Question

I have a hospital spreadsheet with data, where the data is organised depending on age, sex, Health Authority etc. Like this:
Where "sha" means the Health Authority, and each number corresponds to a certain one.
1-Norfolk, Suffolk and Cambridgeshire
2-Bedforshire & Hertfordshire
and so on until Health Authority number 28
I am creating a macro that opens a new sheet, and I need to only paste the data of the patients from a certain Health authority previously selected from a drop-down box.
I have already created the macro that creates the new sheet (i'll paste the code here), but now I need to paste all the data of the patients only if they belong to the health authority selected from the drop-down box.
This is my code so far:
Option Explicit
Sub createsheet()
Dim sName As String, ws As Worksheet
sName = Sheets("user").Range("M42").Value
' check if already exists
On Error Resume Next
Set ws = Sheets(sName)
On Error GoTo 0
If ws Is Nothing Then
' ok add
Set ws = Sheets.Add(after:=Sheets(Sheets.Count))
ws.Name = sName
MsgBox "Sheet created : " & ws.Name, vbInformation
Else
' exists
MsgBox "Sheet '" & sName & "' already exists", vbCritical, "Error"
End If
End Sub

Answer 1

You can call this sub from your sub like:
Transfer_to_NewSheet ws, SHA
Where SHA is the SHA number from whatever drop down you're using.
I'm sure you can figure out how to do that.
Also remember to change:
Set Master = Worksheets("Main")
to whatever your data sheet is called.
Sub Transfer_to_NewSheet(WS As Worksheet, SHA)
Dim Master As Worksheet
Dim DataRG As Range
Dim InArray
Dim OutArray
Dim I As Long
Dim Y As Long
Dim X As Long
Dim W As Long
Dim lRow As Long
Dim lCol As Long
Dim SHAcol As Long
' Or whatever your master sheet is called
Set Master = Worksheets("Main")
With Master
lCol = .Range("ZZ1").End(xlToLeft).Column
lRow = .Range("A" & Rows.Count).End(xlUp).Row
SHAcol = .Range("A1").Resize(1, lCol).Find(What:="sha", LookIn:=xlValues, LookAt:=xlWhole).Column
Set DataRG = .Range("A1").Resize(lRow, lCol)
End With
InArray = DataRG
ReDim OutArray(1 To lRow, 1 To lCol)
Y = 1
For I = 1 To UBound(InArray, 1)
If InArray(I, SHAcol) = SHA Or I = 1 Then
For X = 1 To UBound(InArray, 2)
OutArray(Y, X) = InArray(I, X)
Next X
Y = Y + 1
End If
Next I
WS.Range("A1").Resize(lRow, lCol) = OutArray
End Sub
This is the Data I used to test:
This is the output I get from SHA = 12
And this is the sub I was using to call it, just for reference. don't use it.
Sub CallWSxfer()
Dim SHA As Long
' Or pull it from whatever drop down you're using...
SHA = InputBox("Enter SHA Number:", "SHA to New Sheet", "01")
Transfer_to_NewSheet Sheet4, SHA
End Sub

Answer 2

you can use AutoFilter() method of Range object:
assuming:
data have headers in row 10 from column 1 rightwards and don't have blank rows/columns in between
the searched SHA will always be found in data column F
you could place this snippet right after your MsgBox "Sheet created : " & ws.Name, vbInformation code line
With Sheets("data")
With .Range("A10").CurrentRegion
.AutoFilter field:=6, Criteria1:=sName
.SpecialCells(XlCellType.xlCellTypeVisible).Copy ws.Range("A1")
End With
.AutoFilterMode = False
End With