Error Checking in Excel
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 8 of 8

Thread: Need Help with Search...Copy...Paste Macro

  1. #1
    New Member
    Join Date
    Feb 2002
    Posts
    15
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    The data on sheets 1 thru 30 looks like this:

    L 2800 33/2 PP2-1 CIRCUIT
    3 el-swch
    pd-recep

    I want the macro to go through and find CIRCUIT in column G, copy cells A thru D on that row and paste to Worksheet("Circuit") on the next available row. I have most of the code done but keep running into errors. Could someone out there please look this over and offer some assistance?

    Here is the code:
    Code:
    Sub Circuit()
        Dim oSheet As Variant
        Dim sht As Integer
        Dim Firstcell As Range
        Dim cRow As Integer
        Dim nRow As Integer
        Dim pRow As Integer
        Dim dest As Range
        Dim NextCell As Range
        Dim WhatToFind As Variant
            WhatToFind = "CIRCUIT"
            For sht = 1 To 30
            oSheet = "Sheet" & sht
                Worksheets(oSheet).Activate
                Worksheets(oSheet).[g1].Activate
                Set Firstcell = Cells.Find(What:=WhatToFind, LookIn:=xlValues, LookAt _
                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                    If Not Firstcell Is Nothing Then
                    cRow = Firstcell.Row
                    pRow = Worksheets("Circuit").Range("A65536").End(xlUp).Offset(1, 0)
                    dest = Worksheets("Circuit").Range("A" & pRow & ":D" & pRow)
                    Range("a" & cRow & ":D" & cRow).Copy (dest)
                    On Error Resume Next
                        While (Not NextCell Is Nothing) And (Not NextCell.Address = Firstcell.Address)
                        Set NextCell = Cells.FindNext(After:=ActiveCell)
                            If Not NextCell.Address = Firstcell.Address Then
                    nRow = NextCell.Row
                    pRow = Worksheets("Circuit").Range("A65536").End(xlUp).Offset(1, 0)
                    dest = Worksheets("Circuit").Range("A" & pRow & ":D" & pRow)
                    Range("a" & cRow & ":D" & cRow).Copy (dest)
                            End If
                        Wend
                    End If
                Set NextCell = Nothing
                Set Firstcell = Nothing
                Next sht
    End Sub
    Thank you very much,
    Murph

  2. #2
    MrExcel MVP Al Chara's Avatar
    Join Date
    Feb 2002
    Location
    Newark, Delaware
    Posts
    1,701
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    See if the following works:

    Dim NextAvailableRow As String
    CommandButton1.TakeFocus******* = False
    NextAvailableRow = Intersect(Worksheets("Circuit").UsedRange, Worksheets("Circuit").Columns("A")).Offset(1, 0).Address
    Set c = Worksheets(1).Columns("G").Find("CIRCUIT", LookIn:=xlValues)
    If Not c Is Nothing Then
    firstaddress = c.Address
    Do
    Worksheets("Circuit").Range(Worksheets("Circuit").Range(NextAvailableRow), Worksheets("Circuit").Range(NextAvailableRow).Offset(0, 3)).Value = Worksheets("Sheet1").Range(Range(c.Address).Offset(0, -6), Range(c.Address).Offset(0, -3)).Value
    NextAvailableRow = Range(NextAvailableRow).Offset(1, 0).Address
    Set c = Worksheets(1).Columns("G").FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
    End If

    I wrote it quickly so bear that in mind.
    Best regards,
    Allan Chara
    http://www.mrspreadsheets.com

  3. #3
    New Member
    Join Date
    Feb 2002
    Posts
    15
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Al,

    I tried the routine you gave me and I keep getting a 'Objet Variable or With Block Variable not set' on the line firstAddress = c.Address.

    Here is the new routine.

    Sub Circuit()
    Dim NextAvailableRow As String
    Dim oSheet As Variant
    Dim sht As Integer
    Dim c As Object
    Dim firstAddress As Range
    For sht = 1 To 30
    oSheet = "Sheet" & sht
    Worksheets(oSheet).Activate
    Worksheets(oSheet).[g1].Activate
    NextAvailableRow = Intersect(Worksheets("Circuit").UsedRange, Worksheets("Circuit").Columns("A")).Offset(1, 0).Address
    Set c = Worksheets(oSheet).Columns("G").Find("CIRCUIT", LookIn:=xlValues)
    If Not c Is Nothing Then
    firstAddress = c.Address
    Do
    Worksheets("Circuit").Range(Worksheets("Circuit").Range(NextAvailableRow), Worksheets("Circuit").Range(NextAvailableRow).Offset(0, 3)).Value = Worksheets(oSheet).Range(Range(c.Address).Offset(0, -6), Range(c.Address).Offset(0, -3)).Value
    NextAvailableRow = Range(NextAvailableRow).Offset(1, 0).Address
    Set c = Worksheets(1).Columns("G").FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
    Next sht
    End Sub


    Thanks,
    Murph

  4. #4
    MrExcel MVP Al Chara's Avatar
    Join Date
    Feb 2002
    Location
    Newark, Delaware
    Posts
    1,701
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Don't dim firstaddress as range (it is a string). Use the code exactly as I gave you.
    Best regards,
    Allan Chara
    http://www.mrspreadsheets.com

  5. #5
    New Member
    Join Date
    Feb 2002
    Posts
    15
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Al,

    Thank you very much!!!
    It works great!
    Is there any way to have it find all CIRCUIT on the first 30 sheets of the workbook?

    Thanks,
    Murph

  6. #6
    MrExcel MVP Al Chara's Avatar
    Join Date
    Feb 2002
    Location
    Newark, Delaware
    Posts
    1,701
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Throw it all in a for loop where you have something like the following:

    for i=1 to 30
    worksheets(i)...
    next

    Make sure that the circuit worksheet is not one of the first 30 worksheets.

    Try the following:

    Dim NextAvailableRow, firstaddress As String
    Dim c As Object
    Dim i As Integer
    NextAvailableRow = Intersect(Worksheets("Circuit").UsedRange, Worksheets("Circuit").Columns("A")).Offset(1, 0).Address
    For i = 1 To 30
    Set c = Worksheets(i).Columns("G").Find("CIRCUIT", LookIn:=xlValues)
    If Not c Is Nothing Then
    firstaddress = c.Address
    Do
    Worksheets("Circuit").Range(Worksheets("Circuit").Range(NextAvailableRow), Worksheets("Circuit").Range(NextAvailableRow).Offset(0, 3)).Value = Worksheets(i).Range(Range(c.Address).Offset(0, -6), Range(c.Address).Offset(0, -3)).Value
    NextAvailableRow = Range(NextAvailableRow).Offset(1, 0).Address
    Set c = Worksheets(i).Columns("G").FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
    End If
    Next


    (you can get rid of your code that activates the sheet and cell; I wrote the code so you don't have to activate anything)

    _________________
    Hope this helps.
    Kind regards, Al.

    [ This Message was edited by: Al Chara on 2002-04-03 11:17 ]

  7. #7
    New Member
    Join Date
    Feb 2002
    Posts
    15
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Al,
    I tried but it keeps giving me an error in this line:
    Worksheets("Circuit").Range(Worksheets("Circuit").Range(NextAvailableRow), Worksheets("Circuit").Range(NextAvailableRow).Offset(0, 3)).Value = Worksheets(i).Range(Range(c.Address).Offset(0, -6), Range(c.Address).Offset(0, -3)).Value
    Any idea why? Could it be that I have to define a variable to add "Sheet" & i?

    Thanks,
    Murph

  8. #8
    MrExcel MVP Al Chara's Avatar
    Join Date
    Feb 2002
    Location
    Newark, Delaware
    Posts
    1,701
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    The code Worksheets(1) will look at the first worksheet in the workbook, Worksheets(2) will look at the second worksheet in the workbook, and so on. The following code should work if you have the thirty worksheets in order and Circuit is not one of the first thirty worksheets. You can also replace worksheets(i) with worksheets("Sheet" & i).

    Dim NextAvailableRow, firstaddress As String
    Dim c As Object
    Dim i As Integer
    NextAvailableRow = Intersect(Worksheets("Circuit").UsedRange, Worksheets("Circuit").Columns("A")).Offset(1, 0).Address
    For i = 1 To 30
    Set c = Worksheets(i).Range("G:G").Find("CIRCUIT", LookIn:=xlValues)
    If Not c Is Nothing Then
    firstaddress = c.Address
    Do
    On Error Resume Next
    Worksheets("Circuit").Range(Worksheets("Circuit").Range(NextAvailableRow), Worksheets("Circuit").Range(NextAvailableRow).Offset(0, 3)).Value = Worksheets(i).Range(Worksheets(i).Range(c.Address).Offset(0, -6), Worksheets(i).Range(c.Address).Offset(0, -3)).Value
    NextAvailableRow = Range(NextAvailableRow).Offset(1, 0).Address
    Set c = Worksheets("Sheet" & i).Columns("G").FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
    End If
    Next
    Best regards,
    Allan Chara
    http://www.mrspreadsheets.com

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •