Este fórum está sendo desativado

[duucerqueira]

Olá, pessoal!

Estou precisando de ajuda com uma pequena macro que deve ler todas as células de uma coluna (A), verificar a existência ou não de um conteúdo em cada célula ("Foto do perfil") e, caso positivo, escrever uma mensagem ("POSSUI NOME") na célula da coluna ao lado.

Utilizando outra pequena macro como referência, escrevi o código abaixo, mas ele não está funcionando corretamente. Como resultado, a macro acaba escrevendo em toda a coluna B a mensagem e não apenas nas que possuem o conteúdo pesquisado na célula da coluna A. Segue bloco do código:

Código: Selecionar todos

Sub TestarNomePerfil()
    Dim s As String, Count As Integer
    Let Application.ScreenUpdating = False
    Let s = "Foto do perfil"
    For Count = 1 To ActiveSheet.UsedRange.Rows.Count
        Set f = Cells.Find(s, LookIn:=xlValues)
        If Not f Is Nothing Then
            Cells(Count, 2).Value = "POSSUI NOME"
            Let Application.ScreenUpdating = True
         End If
    Next Count
End Sub

A macro que utilizei como referência está funcionando corretamente (apesar de ser bem lenta). Ela verifica a existência de um conteúdo ("Foto do perfil") e, caso positivo, apaga a linha. Repetindo que esta macro funciona normal. Segue ela:

Código: Selecionar todos

 Sub DeletarLinha()
    Dim s As String, Count As Integer
    Let Application.ScreenUpdating = False
    Let s = "Foto do perfil"
    For Count = 1 To ActiveSheet.UsedRange.Rows.Count
        Set f = Cells.Find(s, LookIn:=xlValues)
        If Not f Is Nothing Then
            f.EntireRow.Delete
            Let Application.ScreenUpdating = True
        End If
    Next Count
End Sub

Enfim, alguém poderia me ajudar a entender o que está acontecendo e, se possível, corrigir o problema?
Um abraço a todos!

[osvaldomp]

Experimente:

Código: Selecionar todos

Sub InsereTexto()
 Dim x As Long, LR As Long
  Application.ScreenUpdating = False
   With ActiveSheet
    .AutoFilterMode = False
    LR = .Cells(Rows.Count, 1).End(3).Row
    .[A1].AutoFilter 1, "*Foto de Perfil*"
     x = .Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).Count
           If x > 1 Then Range("B2:B" & LR).Value = "POSSUI NOME"
    .AutoFilterMode = False
   End With
  Application.ScreenUpdating = True
End Sub

[duucerqueira]

Oi, Osvaldo! Joia?
Muito obrigado pela disposição em ajudar, mas... não funcionou.
O seu código também está exibindo a mensagem em toda a coluna B, e não apenas nas células que possuem de fato a informação pesquisada na célula vizinha da A.

[Reinaldo]

Duas possibilidades:
Sua rotina alterada:

Código: Selecionar todos

Sub TestarNomePerfil()
Dim S As String, Count As Integer
Let Application.ScreenUpdating = False
Let S = "Foto do perfil"
For Count = 1 To ActiveSheet.UsedRange.Rows.Count
    Set f = Cells.Find(S, LookIn:=xlValues, looat:=xlPart)
    If Not f Is Nothing Then
        f.Select
        Selection.Offset(0, 1).Value = "POSSUI NOME"
        Let Application.ScreenUpdating = True
     End If
Next Count
End Sub

ou ainda:

Código: Selecionar todos

Sub tt()
Dim S As String, Count As Integer

For Count = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    'Verifica se o valor é igual ao procurado para exclusão
    If Cells(i, "A").Value Like "*" & S & "*" Then
        Cells(i, "B").Value = "POSSUI NOME"
    End If
Next
End Sub

[osvaldomp]

Não é necessário Loop.
Veja o arquivo anexado.

[duucerqueira]

Reinaldo e Osvaldo, muito obrigado!
Ambos os códigos que escreveram funcionaram!
Valeu!