How do I copy range from one worksheet and paste into new workbook 2

[citizenzen]

Hello.

I am creating a small application that will allow me to copy specific data from a range of cells within one column of one excel worksheet to a new worksheet in a new workbook. How can I copy that specific data to the new worksheet? I am getting errors on the copy and paste portion. I am getting a Run-time error of 9, Subscript out of range. Also, is there a way to obtain the specific error?

Public Function findSystem()

Dim SysCell As Range
Dim System As String

'Excel Properties
Dim rCells As Range
Dim rRange As Range

Excel.Application.DisplayAlerts = False
Application.ScreenUpdating = False

For Each rCells In Worksheets(1).Range("A13:A49")
   
    If InStr(rCells, "SYSTEM NAME:") Then
    System = Mid(rCells, 23, 255)
       
    'worksheets to be copied    
    Workbooks("olddocument.xls").Activate
    Workbooks("olddocument.xls").Worksheets("20MAR08 Complete").Activate
    
    'Copy worksheet to workbook    
'*****ERROR BEGINS HERE*************
    Worksheets("20MAR08 Complete").Copy Before:=Workbooks("selectedData.xls").Sheets(1)

   'I want to copy the data from the 'System' variable
    
'this is wrong, so I commented it out
   ' Range(System).Copy("selectedData.xls").Sheets (1)
       
    Workbooks("selectedData.xls").Sheets(1).Activate
    Workbooks("selectedData.xls").Sheets(1).Activate.Range("A2:A10").Activate
    
    Exit For
    
    End If
    
   Next
    
On Error Resume Next
    
End Function

 

[citizenzen]

ok. the entire function is below. the error is with my destination workbook:

Public Function findSystem()

Dim unitService As Range
Dim rCells As Range

'Excel Properties
Dim xlApp As New Excel.Application

Dim ws_source As Excel.Worksheet
Dim ws_dest As Excel.Worksheet

Dim wb_source As Excel.Workbook
Dim wb_dest As Excel.Workbook

Set wb_source = ThisWorkbook
Set wb_dest = Workbooks.Item("selectedHeadendData.xls")

'Set ws_source = wb_source.Sheets("20MAR08 Complete")
Set ws_source = wb_source.Worksheets("20MAR08 Complete")
Set ws_dest = wb_dest.Worksheets("Sheet1")

Set rCells = ws_source.Cells.Find("SYSTEM NAME:")

If Not rCells Is Nothing Then
    ws_dest.Cells(1, 2) = Mid(rCells.Value, 23)
End If


Set unitService = ws_source.Cells.Find("SERVICE:")
If Not unitService Is Nothing Then
    ws_dest.Cells(1, 3) = Mid(unitService.Value, 20)
End If

On Error Resume Next

Workbooks("selectedHeadendData.xls").Close SaveChanges:=True

End Function

 

[SkipVought]

"the error is with my destination workbook:

Set wb_dest = Workbooks[s].Item[/s]("selectedHeadendData.xls")

this statement will only work if selectedHeadendData.xls is already OPEN.


Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[SkipVought]

Tip:

Any time you find your code performing the same link of thing multiple times, like the find and assign, look at using a loop...

    Dim vValues(1, 1), i As Integer
    
    vValues(0, 0) = "SYSTEM NAME:"
    vValues(0, 1) = "SERVICE:"
    vValues(1, 0) = 23
    vValues(1, 1) = 20
    
    For i = 0 To UBound(sValues)
        Set rCells = ws_source.Cells.Find(sValues(0, i))
        
        If Not rCells Is Nothing Then
            ws_dest.Cells(1, 2 + i) = Mid(rCells.Value, sValues(1, i))
        End If
    Next

Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[citizenzen]

even after revising, i still get an error on the worksheet source:

Set ws_source = wb_source.Sheets("20MAR08 Complete")

the source is the activeworkbook's worksheet 20MAR08 Complete. do i need to add something else?

 

[Bong]

wb_source dim'ed as a workbook. Then you try to set it to a worksheet. That's just not going to happen!

_________________
Bob Rashkin

 

[citizenzen]

i thought that the sheet was an aspect of the workbook. i am not sure how else to set the worksheet.

 

[SkipVought]

Bong, there's nothing wrong with the syntax. This error happens when the OBJECT does not exist.

Step thru you code and use the Watch Window to observe the OBJECTS and VALUES in the offending statement.

Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[citizenzen]

what does this set within the loop? i tried to modify the values as i was under the impression that they were cell locators.

Dim vValues(1, 1)
vValues(0, 0) = "SYSTEM NAME:"
vValues(0, 1) = "SERVICE:"
vValues(1, 0) = 23
vValues(1, 1) = 20

 

[SkipVought]

"what does this set within the loop?"

Do you see where vValue is used within the loop?

Put a break in your code and observe the values in the Watch Window.

Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[PHV]

the source is the activeworkbook's worksheet 20MAR08 Complete
So, replace this:
Set wb_source = ThisWorkbook
with this:
Set wb_source = ActiveWorkbook

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

 

[citizenzen]

thank you all for your help and patience. alot more is clear to me. I am just working on the loop. i am a bit confused by the integers within the array of the loop as only part of the worksheet is copied.

 

[SkipVought]

What happens when you step thru and observe values in the Watch Window?

Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[citizenzen]

nothing. i put the variables in the watch window and it seems to error out at:

 ws_dest.Cells(1, 2 + i) = Mid(rCells.Value, pValues(1, i))

in the watch window, the value for each variable reads
<out of context>

pValues - <conditional watch on an array or record is not allowed>

Revised code:

Public Function findSystem()

Dim rCells As Range

'Excel Properties
Dim xlApp As New Excel.Application

Dim wb_source As Workbook
Dim wb_dest As Workbook

Dim ws_source As Worksheet
Dim ws_dest As Worksheet

Dim pValues(1, 2), i As Integer

Set wb_source = ActiveWorkbook
Set wb_dest = Workbooks.Open("selectedHeadendData.xls")

Set ws_source = ActiveWorkbook.sheets(1)
Set ws_dest = wb_dest.Worksheets("Sheet1")

ws_dest.Range("A1").Value = "System Name"
ws_dest.Range("B1").Value = "Service"
ws_dest.Range("C1").Value = "State"

pValues(0, 0) = "SYSTEM NAME:"
pValues(0, 1) = "SERVICE:"
pValues(0, 2) = "STATE:"
pValues(1, 0) = 23
pValues(1, 1) = 20
pValues(1, 2) = 18


For i = 0 To UBound(pValues)step 1
Set rCells = ws_source.Cells.Find(pValues(0, i))
    
'should loop through entire source workbook from A13:A45181
   If Not rCells Is Nothing Then
       ws_dest.Cells(1, 2 + i) = Mid(rCells.Value, pValues(1, i))
    End If
Next

'Workbooks("selectedHeadendData.xls").Close

On Error Resume Next

End Function

 

[SkipVought]

For i = 0 To UBound(pValues, 2)

I failed to specify which dimension in the UBound. Sorry.

Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[citizenzen]

i finally understand the array!!! thank you all so much! But why does it just copy 2 records? I cut my function and am beginning my search for just all words after 'System Name', 'Service' and 'State'. I am only getting one word for each and then the new workbook opens. Is it opening so quickly because of an error (which is not noted) and why just copy this one line within a workbook that has hundreds of records? why is it not looping? I put the variables in the watch window and everything seems fine now.

Public Function findSystem()

'Excel Properties
Dim xlApp As New Excel.Application
Dim wb_source As Workbook
Dim wb_dest As Workbook
Dim ws_source As Worksheet
Dim ws_dest As Worksheet

Dim rCells As Range
Dim sVal(1, 2), i As Integer

'Set variables
Set wb_source = ActiveWorkbook
Set wb_dest = Workbooks.Open("selectedHeadendData.xls")

Set ws_source = wb_source.Worksheets("20MAR08 Complete")
Set ws_dest = wb_dest.Worksheets("Sheet1")

ws_dest.Range("A1").Value = "System Name"
ws_dest.Range("B1").Value = "Service"
ws_dest.Range("C1").Value = "State"

sVal(0, 0) = "SYSTEM NAME:"
sVal(0, 1) = "SERVICE:"
sVal(0, 2) = "STATE:"
sVal(1, 0) = 23
sVal(1, 1) = 20
sVal(1, 2) = 18

For i = 0 To UBound(sVal, 2)
Set rCells = ws_source.Cells.Find(sVal(0, i))

    If Not rCells Is Nothing Then
        ws_dest.Cells(2, 1 + i) = Mid(rCells.Value, sVal(1, i))
        
    End If
    
Next

On Error Resume Next

End Function

 

[SkipVought]

Your ORIGINAL code had an Exit For in the For...Next loop, once a value was "found" So it only would find ONE OCCURRENCE.

Your CURRENT code has no loop, other than the loop needed to manage the array.

You therefore need an inner loop, similar to the one you had and use a FindNext.


Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[SkipVought]

Since you're finding more than once, I'd go back to your

For Each rCells In Worksheets(1).Range("A13:A49")

rather than Find and FindNext.

Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[citizenzen]

I tried the following in a few combinations and the loop does not loop:

For i = 0 To UBound(sVal, 2)
    Set rCells = ws_source.Cells.Find(sVal(0, i))
   
    If Not rCells Is Nothing Then
      
         ws_dest.Cells(2, 1 + i) = Mid(rCells.Value, sVal(1, i))
         
             Do
               Set rCells = ws_source.Cells.FindNext(rCells)
            Loop While Not rCells Is Nothing
    End If
    Next

and the following for the inner loop:

    For i = 0 To UBound(sVal, 2)
    Set rCells = ws_source.Cells.Find(sVal(0, i))
    
            If Not rCells Is Nothing Then
            ws_dest.Cells(2, 1 + i) = Mid(rCells.Value, sVal(1, i))
             For Each rCells In ws_source.Cells.FindNext(rCells)
             ws_dest.Cells(2, 1 + i) = Mid(rCells.Value, sVal(1, i))
             Next
            End If
    Next

the second loop just prints the second record only. nothing else.

 

[SkipVought]

Try this

    For i = 0 To UBound(pValue, 2)
        For Each rCells In Worksheets(1).Range("A13:A49")
           
            If InStr(rCells, pValue(0, i)) Then
                'now do your thing with this value
                ws_dest.Cells(1, 2 + i) = Mid(rCells.Value, pValue(1, i))
            End If
        Next
    Next

Skip,

_{Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference!}

 

[citizenzen]

i still get one row of data instead of several rows data. it's actually grabbing the last part of my range ("A44:A49") and there is data before and after. Should I define the range differently so that more rows can be copied?

I have this now:

Public Function findSystem()

'Excel Properties
Dim xlApp As New Excel.Application
Dim wb_source As Workbook
Dim wb_dest As Workbook
Dim ws_source As Worksheet
Dim ws_dest As Worksheet

Dim rCells As Range
Dim sVal(1, 3), i As Integer

'Set variables
Set wb_source = ActiveWorkbook
Set wb_dest = Workbooks.Open("selectedHeadendData.xls")

Set ws_source = wb_source.sheets("20MAR08 Complete")
Set ws_dest = wb_dest.Worksheets("Sheet1")

'set column headers
ws_dest.Range("A1").Value = "System Name"
ws_dest.Range("B1").Value = "Service"
ws_dest.Range("C1").Value = "Unit Address"
ws_dest.Range("D1").Value = "State"

sVal(0, 0) = "SYSTEM NAME:"
sVal(0, 1) = "SERVICE:"
sVal(0, 2) = "UNIT ADDRESS:"
sVal(0, 3) = "STATE:"
sVal(1, 0) = 23
sVal(1, 1) = 20
sVal(1, 2) = 25
sVal(1, 3) = 18
   
    For i = 0 To UBound(sVal, 2)        
        For Each rCells In ws_source.Range("A16: A49")
        
        If InStr(rCells, sVal(0, i)) Then        
            ws_dest.Cells(2, 1 + i) = Mid(rCells.Value, sVal(1, i))
           Set rCells = ws_source.Cells.Find(sVal(0, i))
         End If
        Next
    Next


On Error Resume Next

End Function