Font change needed....can someone explain how please?

[Mr Denove]

Sub Test()
    Dim FName As Variant
    FName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Select File To Be Opened")
    If FName = False Then
        Exit Sub
    Else
        Workbooks.Open FName
    End If
    SG_MoveColumns ("Sheet1")
    ThisWorkbook.Activate
    
    MsgBox "TWF Done.Check Columns and Data."
    
    Worksheets("Import Macros").Range("F10").Value = "Done"

End Sub

Sub SG_MoveColumns(sSheetname As String)

    Dim src As Worksheet
    Dim srcLastRow As Double
    Dim srcLastCol As Double
    Dim tgt As Worksheet
    Dim tgtLastRow As Double
    Dim dest As Range
    Dim i As Long
    Dim x As Long
    Dim sColLetter As String
    Dim stgtColLetter As String
    Dim bFoundCol As Boolean
    

    ' Switch screen updating back off
    Application.ScreenUpdating = False

    ' Create objects to use
    Set src = Worksheets(sSheetname)  ' use sheet name passed in to the
    srcLastRow = src.Cells(Rows.Count, 1).End(xlUp).Row
    srcLastCol = src.Cells(1, Columns.Count).End(xlToLeft).Column
    
    Set tgt = Workbooks("Template - Data.xlsm").Worksheets("Leavers (incl SSMA Prog)")
    tgtLastRow = tgt.Cells(Rows.Count, 2).End(xlUp).Row

    ' Selects the columns to be copied
    
 myColumns = Array("Assignment id")

                
    ' Search the source worksheet to find the columns that the required field are in
    For i = 0 To UBound(myColumns)
    On Error Resume Next
            
            ' search the column headers - assume that held in row 1
            '   set the flag to NOT FOUND
            bFoundCol = False
            
            For x = 1 To srcLastCol
            On Error Resume Next
            
                If Trim(UCase(myColumns(i))) = Trim(UCase(src.Cells(1, x).Text)) Then
                    bfound = True
                    
                    ' convert the column number in to a column letter
                    sColLetter = Col_Letter(x)
                    
                    ' convert the array to the target column letter
                    stgtColLetter = Col_Letter(i + 1)
                    
                    ' copy of the column data
                    'Range(sColLetter is the column reference & "2" is the row of that column i.e. 2 omits the header
                    src.Range(sColLetter & "2:" & sColLetter & srcLastRow).Copy tgt.Range(stgtColLetter & tgtLastRow + 1)

                    Exit For
                End If
            
            Next x
    Next i
        
    'Tidy-up created objects
    Set src = Nothing
    Set tgt = Nothing
    
    ' Switch screen updating back on
    Application.ScreenUpdating = True

End Sub

Function Col_Letter(lngCol As Long) As String
    Dim vArr
    
    ' calculate the letter linked to the column
    vArr = Split(Cells(1, lngCol).Address(True, False), "$")
    
    ' return the letter
    Col_Letter = vArr(0)
End Function

src.Range(sColLetter & "2:" & sColLetter & srcLastRow).Copy tgt.Range(stgtColLetter & tgtLastRow + 1)

I borrowed and tweaked this code but would now like to make an amendment that helps the user track the data being pasted as its being added below populated data.
How do I amend this code to paste in either Blue or Red Font?
Thanks in advance

 

[VoG]

Try

src.Range(sColLetter & "2:" & sColLetter & srcLastRow).Copy tgt.Range(stgtColLetter & tgtLastRow + 1)


tgt.Range(stgtColLetter & tgtLastRow + 1).EntireRow.Font.ColorIndex = 3

 

[Andrew Poulsom]

What determines whether the font is blue or red?

 

[Mr Denove]

I have 3 files populating one sheet, would like different colours to show each dataset after it has populated.

Creating macro for someone else to use so its to give reassurance that the data has populated.

Oddly the second source has worked but cant get the third to populate as blue

 

[Mr Denove]

And to add to above it is all the range of pasted data I would like coloured so I am assuming that the Row has to be changed....to Range?

 

[Andrew Poulsom]

You can resize the range like this:

tgt.Range(stgtColLetter & tgtLastRow + 1).Resize(srcLastRow - 1).Font.ColorIndex = 3

 

[Mr Denove]

Excellent Andrew, many thanks for your assistance.

 

[Mr Denove]

HI Andrew,

Apologies for this so late in the day but I would like to paste only the values of the data can you advise which code I need to change?

And also if I wanted to combine two together as they use the same source sheet how do I achieve this?

And lastly, now I have had a chat with the user, where and what do I insert if the source file is already open?

Thanks in advance

 

[Andrew Poulsom]

To past values:

src.Range(sColLetter & "2:" & sColLetter & srcLastRow).Copy
 tgt.Range(stgtColLetter & tgtLastRow + 1).PasteSpecial Paste:=xlpasteValues

Sorry, I don't know what you mean by "combine two together".

You could ask the user with a MsgBox if the workbook is already open (and active) and proceed accordingly.

 

[Mr Denove]

I have two macros similar to the above but with their tgt different as pasting into different spreadsheets, however they both use data from the same source file. That is why I was looking to combine them though I could use the if the file is already open then proceed but not sure how to code that.

Thanks for the pastespecial though.