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!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Column of Data Copied to Separate Worksheets 1

Status
Not open for further replies.

shelby55

Technical User
Jun 27, 2003
1,229
CA
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.
 
Hi Skip

Thanks. Now it stops at the first End With and an error message of "end with without with". If I remove it, then it stops at the next End With and the same message.

Just to recap, I already have all 25 worksheets created from the original code. EACH of those worksheets has incorrect data in B30. So I created another worksheet called rawdata2 and in column A is the caseno of each (which is the tab name of each of the worksheets) and column b is the correct data that should go into B30 of each of the worksheets.

In your code above, you indicate "with rawdata_A" but that is from the original code where we were applying that data to create the worksheets. Because there are so many sheets now to get a value for B30 in each, do we want a "case statement" excluding the non-abstract worksheets? i.e.

Code:
For Each ws In Worksheets
        With ws
            Select Case .Name
                Case "Master_NewA", "Mapping_NewA", "RawData_A", "Mapping_NewB", "Master_NewB", "RawDataA_Map", _
                "Values", "Template", "Mapping_NewC", "Master_NewC"
                Case Else



 
Code:
If Not t Is Nothing Then
  .[B30].Value = Intersect(r.EntireRow, t.EntireRow).Value
End [s]With[/s]If

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Hi Skip

Thanks but it's still not working. It stops at "Next" with the error message "compile error Next without For".

The code to date is this:
Code:
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
                With Sheets(r.Value)
                    Set t = .Cells.Find("rawdata2")
                    
                    If Not t Is Nothing Then
                        .[B30].Value = Intersect(r.EntireRow, t.EntireRow).Value
                    End If
            Next
            
        End If
    End With

End Sub
 
Code:
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
                With Sheets(r.Value)
                    Set t = .Cells.Find("rawdata2")
                    
                    If Not t Is Nothing Then
                        .[B30].Value = Intersect(r.EntireRow, t.EntireRow).Value
                    End If
                End With
            Next
            
        End If
    End With

End Sub

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Hi Skip

The code didn't stop but it doesn't appear to have done anything. I'm still not understanding why you would use the With Sheets as "rawdata_A" because that is the original worksheet that was used as the data source and has all data for abstracts 1 to 25. Don't I want to select the sheets 1 to 25?

Thanks.

 
Hi

This code also doesn't work in that it runs but nothing happens. I've selected only the abstracts that require correction. Can you advise what's wrong with this?

Thanks.

Code:
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
    
For Each Sh In ActiveWorkbook.Worksheets
    Select Case Sh.Name
    
    Case "Master", "Reabstracters", "Master_NewB", "Mapping_NewC", "Master_NewC", _
         "RawData_A", "Mapping_NewA", "RawDataA_Map", "Values", "Master_NewA", "Readme", _
         "Mapping_NewB", "Rat_Val", "Features"
    
    Case Else

       'find the caseno
        Set rSEQ_NO = Sh.Rows(1).Find("CaseNo")
        
        
        If Not rSEQ_NO Is Nothing Then
            'for each caseno
            For Each r In Sh.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
                With Sheets(r.Value)
                    Set t = .Cells.Find("rawdata2")
                    
                    If Not t Is Nothing Then
                        .[B30].Value = Intersect(r.EntireRow, t.EntireRow).Value
                    End If
                    End With
            Next
            End If
            End Select
            Next
                
End Sub



 
Again ...
Code:
For Each r In Sh.Range(rSEQ_NO.Offset(1), rSEQ_NO.Offset(1).End(xlDown))
  Sheets(r.Value).Range("B30").Value = r.Offset(0, 1).Value
Next

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

Did you see my response to your original post? The code you provided caused an "out of stack" error message and also caused Excel to hang so I had to end program. Can you explain why that would happen and will using this current code do the same?

Thanks.

 
Hi

I'm getting a subscript out of range error message on the line
Sheets(r.Value).Range("B30").Value = r.Offset(0, 1).Value...can you advise why that might be?

Thanks very much.
 
what is the value of r.Value at that point in the loop? Hit DEBUG and use the Watch Window to examine [highlight]r.Value[/highlight]

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Hi

It indicates that r is "out of context".

I also don't see in the code below where reference to rawdata2 is for the new, correct values are derived from.

Code:
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
    
For Each Sh In ActiveWorkbook.Worksheets
    Select Case Sh.Name
    
    Case "Master", "Reabstracters", "Master_NewB", "Mapping_NewC", "Master_NewC", _
         "RawData_A", "Mapping_NewA", "RawDataA_Map", "Values", "Master_NewA", "Readme", _
         "Mapping_NewB", "Rat_Val", "Features"
    
    Case Else

       'find the caseno
        Set rSEQ_NO = Sh.Rows(1).Find("CaseNo")
        
        
        If Not rSEQ_NO Is Nothing Then
            'for each caseno
            For Each r In Sh.Range(rSEQ_NO.Offset(1), rSEQ_NO.Offset(1).End(xlDown))
                  Sheets(r.Value).Range("B30").Value = r.Offset(0, 1).Value
Next
            End If
            End Select
            Next
                
End Sub


 
Assumptions:
The sheet with corrected values is named rawdata2, with no header row, column A is CaseNo column B is the new value to place in the coreesponding [B30]
Code:
Sub CorrectData()
Dim r As Range
With Sheets("rawdata2")
    For Each r In Intersect(.Range("A:A"), .UsedRange)
        Sheets(r.Value).Range("B30").Value = r.Offset(0, 1).Value
    Next
End With
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
You might need to begin from scratch to explain your convoluted logic much more clearly than has been conveyed heretofore. It seems we are widely and wildly missing the mark.



Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
PHV, your suggestion results in the same error message about out of range.

The scenario: I have multiple worksheets in a workbook and the worksheets I wish to concern myself with are those that have tab names to match the field of caseno. For all of these worksheets, all data is in the same location on the worksheet. What I want to do is programatically change the data of cell B30 with new values.

I created another worksheet called rawdata2 that has caseno in column A and the correct data for that specific caseno in column B. These are not named ranges, just a worksheet with two columns.

I used the Case Select feature to exclude worksheets that this will not apply to:
Code:
 Case "Master", "Reabstracters", "Master_NewB", "Mapping_NewC", "Master_NewC", _
         "RawData_A", "Mapping_NewA", "RawDataA_Map", "Values", "Master_NewA", "Readme", _
         "Mapping_NewB", "Rat_Val", "Features"

So, how do I programatically take data from rawdata2 and add data from column b of rawdata2 into the matching caseno worksheet column B30? Thanks.
 
Code:
Sub CorrectData()
    Dim r As Range
    
    With Sheets("rawdata2")
        'for each caseno, ASSUMING that HEADERS are in rows 1 & DATA starts in ROW 2
        For Each r In .Range(.Cells(2, "A"), .Cells(2, "A").End(xlDown))
            Sheets(r.Value).[B30].Value = r.Offset(0, 1).Value
        Next
            
    End With

End Sub


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
I used the Case Select feature to exclude worksheets
Where ?
Why ?
Aren't the CaseNo in column A of the rawdata2 sheet already in your Case list ????

BTW, rawdata2 is a sheet in the same workbook, isn't it ?

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

For the code below (which isn't working) I used the case select because not all worksheets in this workbook require changes to cell b30. Yes rawdata2 is in the same workbook as the worksheets requiring changes in cell B30 and yes caseno is in column A so I guess you are correct that I don't need a case select since the others won't have the caseno.

Code:
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
    
For Each Sh In ActiveWorkbook.Worksheets
    Select Case Sh.Name
    
    Case "Master", "Reabstracters", "Master_NewB", "Mapping_NewC", "Master_NewC", _
         "RawData_A", "Mapping_NewA", "RawDataA_Map", "Values", "Master_NewA", "Readme", _
         "Mapping_NewB", "Rat_Val", "Features"
    
    Case Else

       'find the caseno
        Set rSEQ_NO = Sh.Rows(1).Find("CaseNo")
        
        
        If Not rSEQ_NO Is Nothing Then
            'for each caseno
            For Each r In Sh.Range(rSEQ_NO.Offset(1), rSEQ_NO.Offset(1).End(xlDown))
                  Sheets(r.Value).Range("B30").Value = r.Offset(0, 1).Value
Next
            End If
            End Select
            Next
                
End Sub

 
Hi Skip

Just an FYI that the code you provided is adding a value to every worksheet (even those without case numbers) and not matching to caseno.
 
Hi

I'm not sure why, but the code isn't working to find the matching sheet name but instead just whichever is consecutive. To find out what was going where I entered in data from 1 to 25 in column B of rawdata2 so no duplicates. Then I looked at each worksheet to see what data was entered.

Sheet9(RatVal) = caseno2 data
Sheet4(Values) = caseno3 data
Sheet3(RawDataA_Map) = caseno4 data

Interestingly the sheets above were in consecutive order in the workbook i.e. RatVal was first, Values was second, RawDataA_Map was third and this carried through on all other worksheets i.e. the 4th consecutive worksheet had caseno5 data etc. I don't know where caseno1 data is but all other data was placed in B30 consecutively to the worksheet order. It also didn't matter if the worksheets were visible or not for data to be added to them.

Why would it be doing that? Thanks.


 
Please COPY 'n' PASTE the columns a:b containing data in rawdata2.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top