Modify VBA to select Cells with Red Font Copy only cells not row-CodePudding

Thank you for taking time to read this

I am working with a tutorial first time using VBA

At the moment it works when All the text in the row has red font - I need it so that

It only selects the cells with red font and copy those only NOT the entire row and also put the cell in same position on the new sheet it copies to.
Also copy into new sheet the code value in the row Col A see mock-up image

The current code is like this

Sub CopyColouredFontTransactions()

    Dim TransIDField As Range
    Dim TransIDCell As Range
    Dim ATransWS As Worksheet
    Dim HTransWS As Worksheet
    Dim x As Long
    
    Set ATransWS = Worksheets("All Transactions")
    Set TransIDField = ATransWS.Range("A2", ATransWS.Range("A2").End(xlDown))
    Set HTransWS = Worksheets("Highlighted Transactions")
    
    
    For Each TransIDCell In TransIDField
    
        If TransIDCell.Font.Color = RGB(255, 0, 0) Then
           
            TransIDCell.Resize(1, 10).Copy Destination:= _
                HTransWS.Range("A1").Offset(HTransWS.Rows.Count - 1, 0).End(xlUp).Offset(1, 0)
               
        End If
    
    Next TransIDCell
    
    HTransWS.Columns.AutoFit

End Sub

CodePudding user response：

like this:

For Each TransIDCell In TransIDField
    If TransIDCell.Column = 1 Or TransIDCell.Font.Color = vbRed Then
        TransIDCell.Copy HTransWS.Range(TransIDCell.Address)
    End If
Next TransIDCell

CodePudding user response：

Im actually new to vba and I kinda wanna try solve it. I got the output that you want but with a bit spin off on the method of execution. Feel free to comment about this.

Public Sub ClearNormal()

Dim xlw As Worksheet
Dim range_1 As Range
Range("A1").CurrentRegion.Copy Sheets(2).Range("A1")
Sheets(2).Activate

  For Each range_1 In Range("B2:D4")
      If range_1.Font.Color <> vbRed Then
        range_1.ClearContents
   End If
  Next range_1
End Sub