Using VBA to Copy Data/Remove Data across Sheets

[sssyntax]

Hello Excel Community -

I am working on a project to centralize data that we collect onto a workbook. I have been looking around on different forums and websites to guide me on this but I have not had much luck. There is a master spreadsheet holding all crucial data with a face page sheet to have buttons to run all the macros I am going to set up, and here are some of the goals of the macros I would like to set up:

1. Archiving Events -- essentially copy and pasting rows based on a the text within a cell (Complete/Cancelled) into an archive sheet, to show only current and up to date events on the master sheet
2. Copying Rows based on different words onto their respective sheet for example: All 'sub type columns' will move from the master sheet into the breakdown sheet (this sheet is to essentially track events based on a specific disease type)
3. Copying rows and only certain columns from each row into another sheet and to have it paste it several times depending on the number in one of the cells; example:

Master Disease Sheet
[TABLE="width: 500"]
<tbody>[TR]
[TD]Date[/TD]
[TD]Name[/TD]
[TD]Time[/TD]
[TD]Presenter[/TD]
[TD]Completed[/TD]
[TD]Disease Type[/TD]
[TD]# of cases presented[/TD]
[/TR]
[TR]
[TD]1/10/18[/TD]
[TD]Ovarian Overview[/TD]
[TD]6:00 pm[/TD]
[TD]Dr. Smith[/TD]
[TD]Complete[/TD]
[TD]Ovarian[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]1/10/18[/TD]
[TD]Prostate[/TD]
[TD]7:00 pm[/TD]
[TD]Dr. A[/TD]
[TD]Complete[/TD]
[TD]Prostate[/TD]
[TD]3[/TD]
[/TR]
</tbody>[/TABLE]
--> the code would be written to move certain details from the row to another sheet for all disease specific events (Disease Type: Ovarian to move to sheet named: Ovarian, etc), and to look like this:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Date[/TD]
[TD]Name[/TD]
[TD]Presenter[/TD]
[TD]Case #[/TD]
[TD]Pt #[/TD]
[TD]Care Plan[/TD]
[TD]Follow UP Plan[/TD]
[/TR]
[TR]
[TD]1/10/18[/TD]
[TD]Ovarian Overview[/TD]
[TD]Dr. Smith[/TD]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1/10/18 [/TD]
[TD]Ovarian Overview[/TD]
[TD]Dr. Smith[/TD]
[TD]2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1/10/18[/TD]
[TD]Ovarian Overview[/TD]
[TD]Dr. Smith[/TD]
[TD]3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1/10/18[/TD]
[TD]Ovarian Overview[/TD]
[TD]Dr. Smith[/TD]
[TD]4[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1/10/18[/TD]
[TD]Ovarian Overview[/TD]
[TD]Dr. Smith[/TD]
[TD]5[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I have been following tutorials online for the coding mechanism but I am not having much luck. Any guidance on this would be really appreciated.

Thanks!

 

[frank_AL]

I can solve this for you. Working on a solution.

Please help to clarify the request by answering the questions below:

1. Are all activities occurring within one Workbook?
2. I need more of an explanation for your item # 2. You mention All 'sub type columns'. Is this referencing the different values in the Name column? Can you provide an example for this item?

 

[frank_AL]

Here is code to Archive Data

Option Explicit


Sub Archive()
Dim cfws As Worksheet
Dim ctws As Worksheet
Dim i As Long
Dim lastrow As Long
Dim nextrow As Long
Dim status As String


Set cfws = Worksheets("Master")
Set ctws = Worksheets("Archive")
lastrow = cfws.Cells(cfws.Rows.Count, "A").End(xlUp).Row
nextrow = ctws.Cells(ctws.Rows.Count, "A").End(xlUp).Row + 1


For i = 2 To lastrow
    status = cfws.Cells(i, 5).Value
    Select Case status
    Case "Complete", "Cancelled"
        cfws.Range("A" & i & ":G" & i).Cut ctws.Range("A" & nextrow)
        Rows(i).EntireRow.Delete
        i = i - 1
        lastrow = lastrow - 1
        nextrow = nextrow + 1
    End Select
Next i


End Sub

 

[frank_AL]

Here is code for the second item based on my understanding of what you are wanting to do which is:

This code can run either before or after the Archive module is executed, your call on when to run based on whether you want to copy Completed or Cancelled items to these new worksheets.

This code looks at each row on the Master Worksheet, takes the value in the Disease Type Column, determines if a Worksheet already exists and creates the Worksheet if it doesn't exist and then copies the row of data from Master to the next vacant row on the Disease specific Worksheet.

Let me know if that is not what you were wanting with Item 2.

Option Explicit


Sub CreateDiseaseType()


Dim ws As Worksheet
Dim cfws As Worksheet
Dim ctws As Worksheet
Dim i As Long
Dim lastrow As Long
Dim nextrow As Long
Dim SheetName As String
Dim SheetExists As Boolean


Set cfws = Worksheets("Master")
lastrow = cfws.Cells(cfws.Rows.Count, "A").End(xlUp).Row


For i = lastrow To 2 Step -1
    SheetExists = False
    SheetName = cfws.Cells(i, 6).Value
        For Each ws In Worksheets
            If SheetName = ws.Name Then
                SheetExists = True
            End If
        Next ws
    If SheetExists = False Then
        With ThisWorkbook
            Set ctws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            ctws.Name = SheetName
        End With
        cfws.Range("A1:G1").Copy ctws.Range("A1")
    End If
    nextrow = ctws.Cells(ctws.Rows.Count, "A").End(xlUp).Row + 1
    cfws.Range("A" & i & ":G" & i).Copy ctws.Range("A" & nextrow)
Next i


End Sub

 

[frank_AL]

Here is the code for Item 3:
This code creates a new Worksheet based on the value in the Disease Type column then copies the data as requested and creates the number of rows based on the value in the "# of cases presented" column.

My assumption here is that there should never be more that one row per disease type. If that is not true let me know and I can modify that as needed.

Option Explicit


Sub CreateDiseaseSpecificCases()


Dim ws As Worksheet
Dim cfws As Worksheet
Dim ctws As Worksheet
Dim i As Long
Dim x As Long
Dim qty As Long
Dim lastrow As Long
Dim NextRow As Long
Dim SheetName As String
Dim SheetExists As Boolean


Set cfws = Worksheets("Master")
lastrow = cfws.Cells(cfws.Rows.Count, "A").End(xlUp).Row


For i = 2 To lastrow
    SheetExists = False
    SheetName = cfws.Cells(i, 6).Value & " Cases"
        For Each ws In Worksheets
            If SheetName = ws.Name Then
                SheetExists = True
                GoTo NextRow
            End If
        Next ws
    If SheetExists = False Then
        With ThisWorkbook
            Set ctws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            ctws.Name = SheetName
            ctws.Range("A1").Value = "Date"
            ctws.Range("B1").Value = "Name"
            ctws.Range("C1").Value = "Presenter"
            ctws.Range("D1").Value = "Case #"
            ctws.Range("E1").Value = "Pt #"
            ctws.Range("F1").Value = "Care Plan"
            ctws.Range("G1").Value = "Follow Up Plan"
        End With
    End If
    qty = cfws.Cells(i, 7).Value
    For x = 1 To qty
        NextRow = ctws.Cells(ctws.Rows.Count, "A").End(xlUp).Row + 1
        ctws.Range("A" & NextRow) = cfws.Range("A" & i)
        ctws.Range("B" & NextRow) = cfws.Range("B" & i)
        ctws.Range("C" & NextRow) = cfws.Range("D" & i)
        ctws.Range("D" & NextRow) = x
    Next x
    ctws.Range("A2", "A" & (qty + 2)).NumberFormat = "mm/dd/yy"
NextRow:
Next i


End Sub

 

[frank_AL]

Upon a retest I determined the second code module had an error. Corrected code below.

Option Explicit


Sub CreateDiseaseType()


Dim ws As Worksheet
Dim cfws As Worksheet
Dim ctws As Worksheet
Dim i As Long
Dim lastrow As Long
Dim NextRow As Long
Dim SheetName As String
Dim SheetExists As Boolean


Set cfws = Worksheets("Master")
lastrow = cfws.Cells(cfws.Rows.Count, "A").End(xlUp).Row


For i = lastrow To 2 Step -1
    SheetExists = False
    SheetName = cfws.Cells(i, 6).Value
        For Each ws In Worksheets
            If SheetName = ws.Name Then
                SheetExists = True
                Set ctws = Worksheets(SheetName)
            End If
        Next ws
    If SheetExists = False Then
        With ThisWorkbook
            Set ctws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            ctws.Name = SheetName
        End With
        cfws.Range("A1:G1").Copy ctws.Range("A1")
    End If
    NextRow = ctws.Cells(ctws.Rows.Count, "A").End(xlUp).Row + 1
    cfws.Range("A" & i & ":G" & i).Copy ctws.Range("A" & NextRow)
Next i


End Sub

 

[sssyntax]

Thank you so much frank_AL for your assistance on this and your coding, as for your questions:

1. All activities will be in this one workbook, the essential goal of it is to be a log for the current year - which then can be replicated for the next year for recording purposes.
2. So this is currently how the master calendar tracker sheet looks like:

[TABLE="width: 1772"]
<tbody>[TR]
[TD]Date[/TD]
[TD]Time Start[/TD]
[TD]Time End[/TD]
[TD]Title[/TD]
[TD]Location[/TD]
[TD]Teleconference Available?[/TD]
[TD]Type[/TD]
[TD]Sub-Type[/TD]
[TD]Community[/TD]
[TD]Involvment[/TD]
[TD]X Involvement?[/TD]
[TD]X Members[/TD]
[TD]Quarter[/TD]
[TD]Status[/TD]
[/TR]
[TR]
[TD]8-Jan[/TD]
[TD]8:00 AM[/TD]
[TD]9:00 AM[/TD]
[TD]Clinical Research Meeting[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]Clinical Research Subcommittee[/TD]
[TD]Breast[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
We have a column labeled "Type"; and depending on if it is a certain type "A" or "B" it will be copied onto the sheet for 'Tumor Boards/Disease Management Teams' and to look like this (I removed the other columns to the right, as this information would be added once they have been copied over after the meeting/event is complete:

[TABLE="width: 1538"]
<tbody>[TR]
[TD]Date[/TD]
[TD][/TD]
[TD][/TD]
[TD]Title[/TD]
[TD][/TD]
[TD][/TD]
[TD]Type[/TD]
[TD]Sub-Type[/TD]
[TD]Community[/TD]
[TD]Involvment[/TD]
[TD]X Involvement?[/TD]
[TD]X Members[/TD]
[TD][/TD]
[TD]#of Cases[/TD]
[TD]Member[/TD]
[TD]Pt Initials (& MRN)[/TD]
[TD]Diagnosis[/TD]
[TD]Case Presenter[/TD]
[TD]Pathology Review[/TD]
[/TR]
[TR]
[TD]8-Jan[/TD]
[TD][/TD]
[TD][/TD]
[TD]Clinical Research Meeting[/TD]
[TD][/TD]
[TD][/TD]
[TD]Clinical Research[/TD]
[TD]Breast[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Hope this cleared the air -

 

[frank_AL]

Please test the code I provided for Items 1 and 3 and provide feedback.

I'm still confused about Item 2.
In your response: We have a column labeled "Type"; and depending on if it is a certain type "A" or "B" it will be copied onto the sheet for 'Tumor Boards/Disease Management Teams'
What determines "if it is a certain type "A" or "B"". Is there a table somewhere that can be used to test against? The row you show moving has "Clinical Research Subcommittee" so I don't know how to relate that to a type of "A" or "B".

Also, when that row is moved you then show Type to be "Clinical Research" which is shortened from "Clinical Research Subcommittee". How would I determine how to shorten the various possibilities to get the desired result?

Let me know!