Column of Data Copied to Separate Worksheets 1

[shelby55]

Hi

I have a workbook that Skip helped lots with where I have one sheet of data that becomes many sheets (each row of data on the "rawdata" worksheet becomes a single worksheet with the tab showing as the caseno).

I now have to replace a field already on these worksheets but can't just re-run the macro because data has already been entered in different cells.

How would I take this column of data (the replacement data) and map to plunk into each worksheet that matches the caseno?

Thanks.

 

[SkipVought]

Hi,

Please post the macro.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi
Thanks Skip.

The data is mapped on another sheet and that named range is what is cited in the macro. This macro that takes all the data from one sheet, creates a worksheet per row of data into the cells cited in the mapping sheet:

Sub AbstractData()
Dim r As Range, wsAdd As Worksheet, t As Range, rSEQ_NO As Range, s As Range, myPassword As String, ws As Worksheet

If worksheetexists("1") Then
MsgBox "Abstracts have already been created"

Else

Application.EnableEvents = False

With Sheets("RawData_A")
Set rSEQ_NO = .Rows(1).Find("CaseNo")

If Not rSEQ_NO Is Nothing Then
For Each r In .Range(.[A2], .[A2].End(xlDown))

Sheets("Template").Copy After:=Sheets(Sheets.Count)
Set wsAdd = ActiveSheet
Set targcell = wsAdd.Cells(119, 5)

wsAdd.Name = .Cells(r.Row, rSEQ_NO.Column).Value

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:=False

Select Case targcell.Value

    Case "Complete - Changes"
        wsAdd.Tab.Color = 16711680
             'blue
    Case "Follow up required"
        wsAdd.Tab.Color = 204
             'red
     Case "Complete - No Changes"
        wsAdd.Tab.Color = 26112
             'green
     Case "Not reabstracted"
        wsAdd.Tab.Color = 10498160
             'purple
     Case "Optional Changes"
        wsAdd.Tab.Color = 5296274
            'light green
     Case "DQ Flag"
        wsAdd.Tab.Color = 26367
            'orange
     End Select
        
Next t
wsAdd.Range("A5:K34,B36:P60,B73:R92").HorizontalAlignment = xlLeft
wsAdd.Range("A5:K34,B36:P60,B73:R92").VerticalAlignment = xlTop
wsAdd.Range("K5:K10,K12:K16,K18:K23,K25:K27,K29:K34,M36:P71,K73:R103,T12:Y16,T18:Y23,T25:Y25,T36:Y71,T73:Y102").Locked = False

Next

End If
End With

End If
Application.EnableEvents = True

End Sub

 

[SkipVought]

you are doing a PasteSpecial offsetting 2 columns from each cell in [From] whatever that range is.

Where do you want to paste instead?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi Skip

Sorry but I'm not explaining myself well. The worksheet created with this data has the original data in one range (B5:I103) and then reviewers suggest any changes to that data in the cells across from the original in the range of K5:R103.

The macro above is working as I want it to and everything is great. For this one time, incorrect data was used and copied to the multiple worksheets. I can't just re-run this macro because I don't want to create new worksheets or overwrite K5:R103. So I wish to get the column of data that is correct, and overwrite cell B30 for all the worksheets created by the macro above.

Thanks.

 

[SkipVought]

or all the worksheets created by the macro above.

How are they identified?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi

The macro above takes the field of caseno (which is unique to each row of data) and that becomes the tab name of each of these worksheets. So if there were 25 rows of data there will be 25 sheets named 1 thru 25.

 

[SkipVought]

so how would you write that logic?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Skip, that's why I've posted to this site: to help me figure out how to do this.

I'm assuming I need a worksheet with the correct data in a column (rawdata2). This worksheet should have caseno and the corrected column data.
I'll need a mapping worksheet with named ranges for from and to.
Then I'll loop through the worksheets to put this data in the proper cell.

So it's like the original macro to an extent except not creating new worksheets, just looping through those already created to add/edit data.

 

[SkipVought]

I'm assuming I need a worksheet with the correct data in a column (rawdata2).

So I wish to get the column of data that is correct, and overwrite cell B30 for all the worksheets created by the macro above.

Now I'm confused! Is it ONE CELL (B30) or is it column (rawdata2)?

And I also don't understand how "the column of data" will "overwrite cell B30"?

That's even before we decide which sheets get acted upon.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi Skip

There are 25 worksheets that were created from the original macro. In EACH of these 25 worksheets, the cell of B30 must change. The data source to know what to put in B30 for each of these worksheets is located in rawdata2. B30 could be different for worksheet 1 compared to worksheet 15 etc. which is why I'm talking column of data (one value per worksheet) and B30 (the cell within each worksheet that the data will be copied to.

 

[SkipVought]

so what's the logic for a particular cell in rawdata2 to arrive at a specific sheet?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

something like this might work.

Sub CorrectData()
    Dim r As Range, wsAdd As Worksheet, t As Range, rSEQ_NO As Range, s As Range, myPassword As String, ws As Worksheet
    
    With Sheets("RawData_A")
        'find the caseno
        Set rSEQ_NO = .Rows(1).Find("CaseNo")
        
        If Not rSEQ_NO Is Nothing Then
            'for each caseno
            For Each r In .Range(rSEQ_NO.Offset(1), rSEQ_NO.Offset(1).End(xlDown))
                'get the rawdata2 value in the same row as caseno and assign to that sheets b30
                Sheets(r.Value).[B30].Value = Intersect(r.EntireRow, [rawdata2]).Value
                
            Next
            
        End If
    End With

End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi Skip

I get a "run-time error 424 - object required".

What I did was create a new sheet (rawdata2), put only the caseno column and the values that will overwrite cell b30 in the abstracts in column b.

Is there something else I should have done? Thanks.

 

[PHV]

What about this ?

Sub CorrectData()
Dim r As Range
With Sheets("rawdata2")
    For Each r In Intersect(.Range("A:A"), .UsedRange)
        Sheets(r.Value).[B30].Value = r.Offset(0, 1).Value
    Next
End With
End Sub

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

 

[shelby55]

Hi PHV

Thanks for replying. When I use your code I get the error message "out of stack space", hung Excel and it wiped out all data in column B, and didn't enter any data in B30.

Any other ideas? Thanks.

 

[shelby55]

Hi

So any other suggestions for this? Thanks.

 

[SkipVought]

I get a "run-time error 424 - object required".

on what statement?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi Skip

On the line "Sheets(r.Value).[B30].Value = Intersect(r.EntireRow, [rawdata2]).Value"

Thanks.

 

[SkipVought]

Sorry, I was assuming that rawdata2 is a Named Range. Stupid me, as it appears on each sheet, does it not?

so...

Sub CorrectData()
    Dim r As Range, wsAdd As Worksheet, t As Range, rSEQ_NO As Range, s As Range, myPassword As String, ws As Worksheet
    
    With Sheets("RawData_A")
        'find the caseno
        Set rSEQ_NO = .Rows(1).Find("CaseNo")
        
        If Not rSEQ_NO Is Nothing Then
            'for each caseno
            For Each r In .Range(rSEQ_NO.Offset(1), rSEQ_NO.Offset(1).End(xlDown))
                'get the rawdata2 value in the same row as caseno and assign to that sheets b30[b]
                With Sheets(r.Value)
                    Set t = .Cells.Find("rawdata2")
                    
                    If Not t Is Nothing Then
                        .[B30].Value = Intersect(r.EntireRow, t.EntireRow).Value
                    End With
                End With[/b]
            Next
            
        End If
    End With

End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}