From Single Excel Worksheet to Many 1

shelby55 · Jan 16, 2012

Hello

I am using Excel 2002.

I have a worksheet of data where one line of information is a single patient visit.

What I would like to do is take that data and place each patient visit in its own worksheet with the worksheet tab reflecting the case number. I require each worksheet to have the data in the same location i.e. A2 will indicate "chart number" and B2 will have the chart number.

I received help from this forum previously in doing the reverse i.e. many worksheets to create one by having a mapping worksheet indicating the cell title and cell location, naming the ranges and writing a macro to the new worksheet which has the column headers enter. The macro code was:

Code:

Sub Consolidate_OrigA()
'this assumes
' Master sheet for combining data from all other sheets
' HEADINGS in Master in Row 1 starting in column A
' Mapping sheet with NAMED RANGES
'  Source & MasterCOL
    Dim ws As Worksheet, r As Range, wsMSTR As Worksheet, lRow As Long
    
    Set wsMSTR = Sheets("Master_OrigA")
    
    For Each ws In Worksheets
        With ws
            Select Case .Name
                Case "Master_OrigA", "Mapping_OrigA"
                Case Else
                    lRow = wsMSTR.[A1].CurrentRegion.Rows.Count + 1
                    For Each r In [SourceOrigA]
                        wsMSTR.Cells(lRow, r.Offset(0, 2).Value) = .Range(r.Value)
                    Next
            End Select
        End With
    Next
End Sub

Thanks for any and all assistance.

SkipVought · Jan 16, 2012

hi,

Why not use the AutoFilter rather than spawning so many different sheets.

Other more sane and acceptable solutions, as far as best and accepted practices, would include PivotTable with FILTER(S) for patient visit or MS Query with one or more DropDown selections to return the required data.

Multiple sheets/charts/reports, multiply your maintenance and bloat your workbook.

Skip,
_{Just traded in my old subtlety...

for a NUANCE!}

SkipVought · Jan 16, 2012

However, if you insist on this course of action, turn on your macro recorder and record inserting a sheet, selecting a row of data and pasting into the new sheet.

Turn off your recorder and post your recorded code for help customizing.

Skip,
_{Just traded in my old subtlety...

for a NUANCE!}

shelby55 · Jan 16, 2012

Hi Skip

The reason is because each worksheet is used in a chart review so the reviewers want to see the current data and then add in any suggested changes to the data. Having each visit in a single worksheet is easier for the coding staff to review. I then extract the information to a single worksheet (as per my previous solution) to summarize changes.

Thanks.

SkipVought · Jan 16, 2012

Proceed...

Skip,
_{Just traded in my old subtlety...

for a NUANCE!}

shelby55 · Jan 16, 2012

Hi Skip

I inserted a new worksheet and copied the information as transposed from the line of data and got this code:

Code:

Sub NewAbstract()

    Sheets("Patient #1").Select
    Sheets.Add
    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Sheets("Master_OrigA").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("A2:R2").Select
    Selection.Copy
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Sheet2").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Columns("B:B").EntireColumn.AutoFit
End Sub

This is assuming that the data is supposed to be all in one column but it isn't. For instance, data from AF to BD in the "one" worksheet needs to be transposed to C35 to C59.

Also, I would like labels in column A so is it possible to create a template worksheet with all the labels and then just keep copying it with the addition of the new data per line of data in the "one" worksheet? Thanks.

SkipVought · Jan 16, 2012

Well then, RECORD EVERYTHING that you want to happen and post back with ONE recorded macro, please.

Skip,
_{Just traded in my old subtlety...

for a NUANCE!}

shelby55 · Jan 16, 2012

Hello

Okay, I took one of the worksheets and saved it as "template" worksheet and copied from the "one" worksheet to the template which created the following code:

Code:

Sub AbstractData()

    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Sheets("Master_OrigA").Select
    Selection.Copy
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Template").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWindow.SmallScroll Down:=18
    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Sheets("Master_OrigA").Select
    Range("AF2:BD2").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Template").Select
    Range("C35").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWindow.SmallScroll Down:=-33
    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Sheets("Master_OrigA").Select
    Range("BE2:CC2").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Patient #1").Select
    ActiveWindow.SmallScroll Down:=-45
    Sheets("Template").Select
    ActiveWindow.SmallScroll Down:=6
    Range("D35").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Sheets("Master_OrigA").Select
    Range("CD2:DB2").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Template").Select
    Range("F35").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWindow.SmallScroll Down:=42
End Sub

Thanks.

SkipVought · Jan 16, 2012

Don't understand what the template is doing???

What's s special about ROW 35 in your posted macro for PASTING?

Is that the NEXT row below the current UsedRange?

Skip,
_{Just traded in my old subtlety...

for a NUANCE!}

SkipVought · Jan 16, 2012

Also, these first few lins have an AMBIGUOUS Selection reference! Exactly WHAT is selected, in order that the NEXT row's selection can be coded!!!

Code:

Sub AbstractData()

    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Sheets("Master_OrigA").Select
    [highlight]Selection[/highlight].Copy

Skip,
_{Just traded in my old subtlety...

for a NUANCE!}

shelby55 · Jan 16, 2012

Hi

The template has the labels per cell that I would like i.e. A3 = "Case Number" and A4 = "Chart Number" and A5 = "Account Number" while the data is contained in cells B3 to B5. As I requested in a previous post, I was wondering if having this same worksheet copied with the new set of data and renaming to the case number is possible.

Anyway, in the "one" worksheet, data from cells A2 to AE2 are transposed and copied to B3 to B33 in the template. Then Row 35 starts the diagnosis information but there are many data elements for diagnoses. So diagnosis prefix is AF2 to BD2 in the "one" worksheet and transposed to B35 to B59. Diagnosis code is BE2 to CC2 is transposed to C35 to C59; diagnosis type is CD2 to DB2 and transposed to C35 to C59.

Row 34 also has labels in the cells so it isn't available for data entry.

Is that what you meant?

shelby55 · Jan 16, 2012

Hi

I believe your second query is answered by my last query i.e. the selection in the worksheet currently called "Master_OrigA" which is the "one" worksheet is A2 to AE2 and is copied to B3 to B33 in the template (transposed).

Is that what you meant?

SkipVought · Jan 16, 2012

This loops thru the Master and copies the data from each row to a new template

Code:

Sub AbstractData()
    Dim r As Range
    
    With Sheets("Master_OrigA")
        For Each r In Range([A2], [A2].End(xlDown))[b]
            'copy TEMPLATE SHEET HERE and Rename
        
  ' assign the added template to the wsADD object
  '          Set wsADD = YourTemplateSheet      '<<<Make this a statement!!!
  '^^^take this comment off when your complete this code^^^
 [/b]       
            .Range(.Cells(r.Row, "A"), .Cells(r.Row, "AE")).Copy
            Sheets("Template").Range("B3").PasteSpecial _
                Paste:=xlPasteAll, _
                Operation:=xlNone, _
                SkipBlanks:=False, _
                Transpose:=True
            
            .Range(.Cells(r.Row, "AF"), .Cells(r.Row, "BD")).Copy
            Sheets("Template").Range("C35").PasteSpecial _
                Paste:=xlPasteAll, _
                Operation:=xlNone, _
                SkipBlanks:=False, _
                Transpose:=True
                
            .Range(.Cells(r.Row, "BE"), .Cells(r.Row, "CC")).Copy
            Sheets("Template").Range("D35").PasteSpecial _
                Paste:=xlPasteAll, _
                Operation:=xlNone, _
                SkipBlanks:=False, _
                Transpose:=True
                
            .Range(.Cells(r.Row, "CD"), .Cells(r.Row, "BD")).Copy
            Sheets("Template").Range("F35").PasteSpecial _
                Paste:=xlPasteAll, _
                Operation:=xlNone, _
                SkipBlanks:=False, _
                Transpose:=True
        Next
    End With
End Sub

Skip,
_{Just traded in my old subtlety...

for a NUANCE!}

SkipVought · Jan 16, 2012

Even more compact, if you have a sheet for your From Thru copy paste table with NAMED RANGES...

Code:

Sub AbstractData()
    Dim r As Range, wsADD As Worksheet, t As Range
    
    With Sheets("Master_OrigA")
        For Each r In Range([A2], [A2].End(xlDown))
            'copy TEMPLATE SHEET HERE and Rename
            
  'take this comment off when your complete this code
            Set wsADD = Sheets("Template")
            wsADD.Name = "??????"
        
 'From Thru Target
 'A    AE   B3
 'AF   BD   C35
 'BE   CC   D35
 'CD   BD   F35
            
            For Each t In [From]
                .Range(.Cells(r.Row, t.Value), .Cells(r.Row, t.Offset(0, 1).Value)).Copy
                wsADD.Range(t.Offset(0, 2).Value).PasteSpecial _
                    Paste:=xlPasteAll, _
                    Operation:=xlNone, _
                    SkipBlanks:=False, _
                    Transpose:=True
            Next
        Next
    End With
End Sub

Skip,
_{Just traded in my old subtlety...

for a NUANCE!}

shelby55 · Jan 16, 2012

Thanks so much, Skip. I'll give this a whirl and let you know how I do.

shelby55 · Jan 16, 2012

Hi Skip

Sorry but one more question: How do I change the label of each worksheet to be that of the case number?

Thanks.

PHV · Jan 16, 2012

Replace this:
wsADD.Name = "??????"
with this:
wsADD.Name = r.Value

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

shelby55 · Feb 19, 2012

Hi Skip

Sorry but I can't get this to work. Can you please explain in the second scenario where the named ranges are being referenced?

Interestingly, I get the template to change to the first case number as per PHV's code, but then I get the message "object required" so I'm assuming it's becuase the template is now renamed and isn't there to copy for the rest of the data in the list?

Thanks for any assistance you can provide.

SkipVought · Feb 20, 2012

My suggestion was to create a table that describes the ranges you want to COPY and the range where the PASTE should occur. It is much easier to change data in a table, than it is to change data and code in VBA.

As a matter of practice, like breathing, I use named ranges to refer to the ranges in a table for instance. In this case, the mapping table I suggested. The headings are From, Thru, Target, so 1) SELECT the entire table, 2) Insert > Names > Name -- Create names in TOP row. NOW you can see the NAMES in the Name Box AND if you SELECT any Name in the Name Box, the corresponding RANGE on your sheet will be selected. If you don't, you have not create the named ranges.

Is this what you were referring to?

LEARN Named Ranges. USE Named Ranges. You will LOVE Named Ranges!

BTW, The last code I posted with the mapping table in COMMENTS, works in my test, just this AM.

Skip,
_{Just traded in my old subtlety...

for a NUANCE!}

shelby55 · Feb 20, 2012

Hi Skip

In the second "compact" code you provided you have "from", "thru" and "target" commented out. How do I reference them in the actual code?

Thanks.

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

From Single Excel Worksheet to Many 1

Technical User

Programmer

Programmer

Technical User

Programmer

Technical User

Programmer

Technical User

Programmer

Programmer

Technical User

Technical User

Programmer

Programmer

Technical User

Technical User

MIS

Technical User

Programmer

Technical User

Similar threads

Log in

Part and Inventory Search

Sponsor