Find text and copy row

[fari1]

hi, my below code finds the text "consolidated" and in sheet3 list all the cells that contain consolidated. i want this code to copy the whole instead of that cell which contains consolidated and gives the output in sheet3.e.g

      A             B            C                    D                  E
        Consolidated                 sheets             result

with reference to the above example i want to get the complete row copied as a result of this code in sheet3.the code is below

Sub findTEXT()
Dim f As Range, fa As String, i As Long
Dim src As Worksheet, dst As Worksheet
Set src = Sheets("sheet2") 'sheet to be searched, change as required
Set dst = Sheets("sheet3") 'sheet for output, change as required
i = 1
With dst
    Set f = src.Cells.Find(What:="CONSOLIDATED", After:=src.Cells(1), LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
If Not f Is Nothing Then
fa = f.Address
Do
    If Len(f.Value) < 50 Then
    .Range("A" & Rows.Count).End(xlUp)(2) = f.Value
    .Range("B" & Rows.Count).End(xlUp)(2) = src.Range("A1").Value
i = i + 1
End If
    Set f = src.Cells.FindNext(f)
    Loop Until fa = f.Address
End If
End With
End Sub

 

[tigeravatar]

Oh, I see. When it finds consolidated, if the cell containing consolidated has a total text length of 50 or more, then you don't want that result, got it. will update code in a sec

 

[fari1]

not just the cell, the total row's Len if is more than 50 then i dont want the row

 

[fari1]

the rangall, in your code, the rangall is the range which contains consolidated right?
if that rngall (meaning the len of every cell in that row) is greater than 50 then i dont want that row

 

[tigeravatar]

ah, k. updating

 

[tigeravatar]

fari1,

Updated code. It also includes a function called RowLen that gets the length of combined text in the row. See if that works for you

Sub findTEXT()
    
    Static wsSrc As Worksheet: Set wsSrc = ActiveWorkbook.Sheets("Sheet2")
    Static wsDst As Worksheet: Set wsDst = ActiveWorkbook.Sheets("Sheet3")
    
    Static StartAddress As String
    Dim rngFnd As Range
    Dim rngAll As Range
    Dim allfound As Boolean
    
    Set rngFnd = wsSrc.UsedRange.Find("consolidated")
    If Not rngFnd Is Nothing Then StartAddress = rngFnd.Address
    
    While Not rngFnd Is Nothing And allfound = False
        If RowLen(wsSrc, rngFnd) < 50 And rngAll Is Nothing Then Set rngAll = rngFnd
        Set rngFnd = wsSrc.UsedRange.Find("consolidated", rngFnd)
        If RowLen(wsSrc, rngFnd) < 50 Then
            If rngAll Is Nothing Then Set rngAll = rngFnd
            If Intersect(rngAll, rngFnd) Is Nothing _
            And Intersect(rngAll.EntireRow, rngFnd) Is Nothing _
            Then Set rngAll = Union(rngAll, rngFnd)
        End If
        If rngFnd.Address = StartAddress Then allfound = True
    Wend
    If Not rngAll Is Nothing Then rngAll.EntireRow.Copy wsDst.Cells(Rows.Count, "A").End(xlUp).Offset(1)
    
End Sub
Function RowLen(ws As Worksheet, rng As Range) As Long
    
    Dim c As Range
    For Each c In Intersect(rng.EntireRow, ws.UsedRange)
        RowLen = RowLen + Len(c.Text)
    Next c
    
End Function

Hope that helps,
~tigeravatar

 

[fari1]

perfect thanks so much