Filtering data and copying it to a new sheet-CodePudding

I have a survey with health data from patients. I have a sheet with all the data named "data",

This is how the data sheet looks like, each column being some category from the patient (there are more rows):

I am creating a macro where the user has to select a Health Authority from a drop-down box, and that will create a new sheet named as the health authority selected. The button assigned to the macro is on another sheet called "user".

This is my code so far: EDIT: I added sub demo () to try and paste it but it did not work. It says variable not defined in the part " With Sheets(sName)"

Option Explicit

Sub createsheet2()

   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

Sub demo()

   Const COL_HA = 6 ' F

   Dim id As Long, rng As Range
   id = 20 ' get from user dropdown
   
   With Sheets("user")
       .AutoFilterMode = False
       .UsedRange.AutoFilter field:=COL_HA, Criteria1:=id
       Set rng = .UsedRange.SpecialCells(xlVisible)
   End With
   
   ' new sheet
'here is the problem
   With Sheets(sName)
      rng.Copy .Range("A1")
      .Range("A1").Activate
   End With

End Sub

I need to write the code that inserts in the new sheet only the data of the patients of the chosen Health Authority. Each Health Authority corresponds to a number

"sha" column is the health authority that the user previously selected. Does anyone know how to insert the data I need to this new created sheet?

I think that I need to filter the data first and then paste it inside the sheet. I am very new at VBA and I'm lost.

CodePudding user response：

Replace your code with this

Option Explicit

Sub createsheet()

    Const COL_HA = 6 ' F on data sheet is Health Auth

    Dim sName As String, sId As String
    Dim wsNew As Worksheet, wsUser As Worksheet
    Dim wsIndex As Worksheet, wsData As Worksheet
    Dim rngName As Range, rngCopy As Range
    
    With ThisWorkbook
         Set wsUser = .Sheets("user")
         Set wsData = .Sheets("data")
         Set wsIndex = .Sheets("index")
    End With
         
    ' find row in index table for name from drop down
    sName = Left(wsUser.Range("M42").Value, 30)
    Set rngName = wsIndex.Range("L5:L32").Find(sName)
    If rngName Is Nothing Then
        MsgBox "Could not find " & sName & " on index sheet", vbCritical
    Else
        sId = rngName.Offset(, -1) ' column to left
    End If
    
    ' create sheet but check if already exists
    On Error Resume Next
    Set wsNew = Sheets(sName)
    On Error GoTo 0
    
    If wsNew Is Nothing Then
        ' ok add
        Set wsNew = Sheets.Add(after:=Sheets(Sheets.Count))
        wsNew.Name = sName
        MsgBox "Sheet created : " & wsNew.Name, vbInformation
    Else
        ' exists
        MsgBox "Sheet '" & sName & "' already exists", vbCritical, "Error"
        Exit Sub
    End If
    
    ' filter sheet and copy data
    Dim lastrow As Long, rngData As Range
    With wsData
        lastrow = .Cells(.Rows.Count, COL_HA).End(xlUp).Row
        Set rngData = .Range("A10:Z" & lastrow)
        .AutoFilterMode = False
        rngData.AutoFilter Field:=COL_HA, Criteria1:=sId
        Set rngCopy = rngData.SpecialCells(xlVisible)
        .AutoFilterMode = False
    End With
   
    ' new sheet
    With wsNew
        rngCopy.Copy .Range("A1")
        .Range("A1").Activate
    End With
    
    MsgBox "Data for " & sId & " " & sName _
         & " copied to wsNew.name", vbInformation
   
End Sub