.Find function

Hi- I am struggling a bit with the find function. I currently have a summary sheet called "Comments" and I have a data sheet called "Data". In my comments sheet, I am showing the following 7 columns (I have an empty column in between each):
1. Company name (column B)
2. Type of business (column D)
3. Date (column F)
4. Type of business code (column H)
5. Clientel (column J)
6. Revenue (column L)
7. Comments (column N)

These 7 columns are being populated from the Data tab manually. the Data tab has about 25 columns of data, and I want my VBA to:
1. look in column 21, which is a column full of formulas, and find every cell with a "yes"
2. in that same row, grab the information needed above, and place it into the Comments tab.

The VBA below gets me halfway there... If there are 15 cells in column 21 with the value of "yes", then there should be 15 rows in the Comments tab. I'm having a hard time finding the "yes" in column 2, then placing it in Comments tab, then going to the next "yes" value in column 21 and placing in the next row of the Comments tab. Very hard to follow- I'm sorry. Here is what I have so far:

Worksheets("Comments").Range("B4:N1000").ClearContents
 
 
Dim lCount As Long

Dim TheMark As Range



    Set TheMark = Worksheets("Data").Range("U1")


        Worksheets("Data").Activate
        For lCount = 1 To WorksheetFunction.CountIf(Columns(21), "yes")

            Set TheMark = Columns(21).Find(what:="yes", after:=TheMark, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

            

             With TheMark
                .Offset(0, -18).Select
                 Set LegalEntity = ActiveCell
                    Worksheets("Comments CMC & NYB").Range("B4").Value = LegalEntity
                    
                .Offset(0, -5).Select
                 Set LineOfBusiness = ActiveCell
                    Worksheets("Comments CMC & NYB").Range("D4").Value = LineOfBusiness
         
                .Offset(0, -19).Select
                 Set TradeDate = ActiveCell
                    Worksheets("Comments CMC & NYB").Range("F4").Value = TradeDate
                    
                .Offset(0, -4).Select
                 Set ErrorType = ActiveCell
                    Worksheets("Comments CMC & NYB").Range("H4").Value = ErrorType
                    
                .Offset(0, -14).Select
                 Set Counterparty = ActiveCell
                    Worksheets("Comments CMC & NYB").Range("J4").Value = Counterparty
                    
                .Offset(0, -17).Select
                 Set PNL = ActiveCell
                    Worksheets("Comments CMC & NYB").Range("L4").Value = PNL
                    
                .Offset(0, -11).Select
                 Set Comments = ActiveCell
                    Worksheets("Comments CMC & NYB").Range("N4").Value = Comments
                
                
             End With

            

        Next lCount

If you are just copying "yes" to the comments column why can you not use a formula in the comments column?

Code Tags Added
Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found at http://www.excelforum.com/forum-rule...rum-rules.html

Please read the forum rules and abide by them in the future



(I have added them for you today. Please take a few minutes to read all Forum Rules and comply in the future.)

Perhaps...

Sub test()
Worksheets("Comments").Range("B4:N1000").ClearContents
'Declareing worksheet variables allows you to refer to specific sheets without activating them
Dim wsData As Worksheet
Dim wsComment As Worksheet
Dim lCount As Long
Dim CommRow As Long
Dim TheMark As Range

Set wsData = ThisWorkbook.Worksheets("Data")  'Instantiate worksheet variable declared above
Set wsComment = ThisWorkbook.Worksheets("Comments CMC & NYB")

Set TheMark = wsData.Range("U1")

CommRow = 4 'Start at row 4 ... change as needed

For lCount = 1 To WorksheetFunction.CountIf(wsData.Columns(21), "yes")

    Set TheMark = wsData.Columns(21).Find(what:="yes", after:=TheMark, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

    With TheMark
        'you don't need to select the cell to get or transfer its value
        Worksheets("Comments CMC & NYB").Range("B" & CommRow).Value = .Offset(0, -18).Value
        
        wsComment.Range("D" & CommRow).Value = .Offset(0, -5).Value
    
        wsComment.Range("F" & CommRow).Value = .Offset(0, -19).Value
    
        wsComment.Range("H" & CommRow).Value = .Offset(0, -4).Value
        
        wsComment.Range("J" & CommRow).Value = .Offset(0, -14).Value
    
        wsComment.Range("L" & CommRow).Value = .Offset(0, -17).Value
    
        wsComment.Range("N" & CommRow).Value = .Offset(0, -11).Value
    
    End With

    CommRow = CommRow + 1  'Itterate to the next row after values are inserted

Next lCount

End Sub

Ok

This is the fast way to do what you want.

This finds Yes in Column 3 and puts a Yes in Column 5.

Sub macro()
    With Columns(3)
        Set rngfind = .Find("Yes", .Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole)
        If Not rngfind Is Nothing Then
            strFirstAddress = rngfind.Address
            Set rngpicked = rngfind
            Do
                rngpicked.Offset(0, 2).Value = "Yes"
                Set rngfind = .FindNext(rngfind)
            Loop While Not rngfind Is Nothing And rngfind.Address <> strFirstAddress
        End If
    End With
    
End Sub

I'm not sure what would be causing this behavior. It works fine in my test (see attached).

http://www.excelforum.com/attachment...1&d=1460474277

Originally Posted by rgiglio7489

very interesting... I just tried yours and it works in your spreadsheet. the only difference between mine and yours is that all of my data is in a table, and some of the values are formulas (but thats covered with LookIn:=xlFormulas). any ideas? I'm still playing around with it... does excel version matter?

The addition of a table to my test did not alter the result. There must be something else going on. Perhaps if you could upload the workbook you are working with.

@jolivanes I agree there are better ways to achieve the desired result, however what you have suggested is not quite what @rgiglio7489 is trying to do. Below is your code with some alterations to do what @rgiglio7489 wants.

Sub With_AutoFilter_Maybe()

Dim wsData As Worksheet
Dim wsComment As Worksheet
Dim lr As Long

'For some reason I could not get the ListObject to work with the object wsData...it would only work with the ActiveSheet object

If ActiveSheet.Name = "Data" Then
    Set wsComment = ThisWorkbook.Worksheets("Comments CMC & NYB")
      Application.ScreenUpdating = False
      With ActiveSheet
        .ListObjects("Table1").Range.AutoFilter Field:=21, Criteria1:="yes"           'change "Table1" to whatever the name of your table is
        lr = .Cells(Rows.Count, 21).End(xlUp).Row
        If lr > 1 Then
            .Range(.Cells(2, 3), .Cells(lr, 3)).SpecialCells(12).Copy Destination:=wsComment.Range("B4")
            .Range(.Cells(2, 16), .Cells(lr, 16)).SpecialCells(12).Copy Destination:=wsComment.Range("D4")
            .Range(.Cells(2, 2), .Cells(lr, 2)).SpecialCells(12).Copy Destination:=wsComment.Range("F4")
            .Range(.Cells(2, 17), .Cells(lr, 17)).SpecialCells(12).Copy Destination:=wsComment.Range("H4")
            .Range(.Cells(2, 7), .Cells(lr, 7)).SpecialCells(12).Copy Destination:=wsComment.Range("J4")
            .Range(.Cells(2, 4), .Cells(lr, 4)).SpecialCells(12).Copy Destination:=wsComment.Range("L4")
            .Range(.Cells(2, 10), .Cells(lr, 10)).SpecialCells(12).Copy Destination:=wsComment.Range("N4")
        End If
        .AutoFilterMode = False
      End With
    Application.ScreenUpdating = True
End If
End Sub

I think the code below will deliver the results you are looking for...

Option Explicit
Sub With_AutoFilter_Maybe()

Dim wsData As Worksheet
Dim wsComment As Worksheet
Dim lr As Long

'For some reason I could not get the ListObject to work with the object wsData...it would only work with the ActiveSheet object

If ActiveSheet.Name = "Data" Then
    Set wsComment = ThisWorkbook.Worksheets("Comments Me & You")
      Application.ScreenUpdating = False
      With ActiveSheet
        .ListObjects("Table_List63680").Range.AutoFilter Field:=21, Criteria1:="yes"           'change "Table1" to whatever the name of your table is
        lr = .Cells(Rows.Count, 21).End(xlUp).Row
        If lr > 1 Then
            .Range(.Cells(2, 3), .Cells(lr, 3)).SpecialCells(12).Copy Destination:=wsComment.Range("B4")
            .Range(.Cells(2, 16), .Cells(lr, 16)).SpecialCells(12).Copy Destination:=wsComment.Range("D4")
            .Range(.Cells(2, 2), .Cells(lr, 2)).SpecialCells(12).Copy Destination:=wsComment.Range("F4")
            .Range(.Cells(2, 17), .Cells(lr, 17)).SpecialCells(12).Copy Destination:=wsComment.Range("H4")
            .Range(.Cells(2, 7), .Cells(lr, 7)).SpecialCells(12).Copy Destination:=wsComment.Range("J4")
            .Range(.Cells(2, 4), .Cells(lr, 4)).SpecialCells(12).Copy Destination:=wsComment.Range("L4")
            .Range(.Cells(2, 10), .Cells(lr, 10)).SpecialCells(12).Copy Destination:=wsComment.Range("N4")
        End If
        
        .ListObjects("Table_List63680").Range.AutoFilter
      End With
    Application.ScreenUpdating = True
Else
    MsgBox "The 'Data' Sheet must be active to run this code!", vbCritical
End If
End Sub