CODEWITHSUNDEEP
excelvba
Goldy
Goldy

Reputation: 41

Look for certain value and copy certain cell value in the same row

I want to look for a value "25" in column L, then according to the value copy the values in Column A to a different sheet in cell value "G1".

Upvotes: 0

Views: 116

Answers (1)

Zac
Zac

Reputation: 1944

Below is an approach using Filter

Sub FindingValues()

        Dim oFilterWS As Worksheet: Set oFilterWS = ThisWorkbook.Worksheets("Sheet3")         '<- Change the sheet name to the sheet you want to filter
        Dim oCopyToWS As Worksheet: Set oCopyToWS = ThisWorkbook.Worksheets("Sheet4")         '<- Change the sheet name to the one you want to copy to
        Dim sLastCol As String: sLastCol = Split(oFilterWS.Cells(1, oFilterWS.Columns.Count).End(xlToLeft).Address, "$")(1)
        Dim iLastRow As Long: iLastRow = oFilterWS.Cells(oFilterWS.Rows.Count, 1).End(xlUp).Row
        Dim oRng As Range, oRow As Range
        Dim sResults As String, sVal As String: sVal = "25"
        
        
        With oFilterWS
            
            ' Clear autofilter
            If .AutoFilterMode Then .AutoFilterMode = False
            
            ' Set filter
            Set oRng = .Range("A1:" & sLastCol & iLastRow)
            oRng.AutoFilter 12, "=" & sVal
            Set oRng = oRng.SpecialCells(xlCellTypeVisible)
            
            ' Get the values from filtered range in column A
            For Each oRow In oRng.Rows
                
                If oRow.Row <> 1 Then
                    If Len(Trim(sResults)) = 0 Then
                        sResults = oRow.Cells(1, 1).Value
                    Else
                        sResults = sResults & "," & oRow.Cells(1, 1).Value
                    End If
                End If
                
            Next
            
            If .AutoFilterMode Then .AutoFilterMode = False
            
        End With
        
        ' Copy results in G1 range of another sheet
        oCopyToWS.Range("G1").Value = sResults
        
End Sub

Upvotes: 1

Related Questions