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

 

[Mr Denove]

Morning All,

Using the same code as posted above, how do I amend the fileopen code to continue if the file is already open?

Thanks in adavance

 

[Andrew Poulsom]

Maybe:

Sub Test()
    Dim FName As Variant
    If MsgBox("Is the source workbook already open and active?", vbYesNo) = vbNo Then
        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
    End If
    SG_MoveColumns ("Sheet1")
    ThisWorkbook.Activate
    
    MsgBox "TWF Done.Check Columns and Data."
    
    Worksheets("Import Macros").Range("F10").Value = "Done"
End Sub

 

[Mr Denove]

Thanks Andrew.

This is an option though currently looking at how I can call the code I have created for another sheet and use the FName from the above code and pass it into the code that is being called.

Is this possible?

ie Code 1 runs like the original code with FName picked up from the GetOpenFilename

Code 2 is called from within code 1 and the FName passed from code 1 to code 2 as it will be the same filename (but varies month to month hence cannot hard code it)

 

[Andrew Poulsom]

If you declare FName at the top of the module (and only there) it will be visible to all procedures in the module.

 

[Mr Denove]

That makes kinda sense in some ways, but does that make a difference if I am calling another sub which refers to the AaA sheet?

 

[Andrew Poulsom]

What's the 'AaA sheet'?

 

[Mr Denove]

The code is picking up a file that changes name each month, the data contained sources two sheets within the same workbook Starts and AaA Starts. Apologies if that wasnt made clear.

The code I have is replicated for other source/destination files, however this is the only one that will share the same source file and seems to make more sense to use the FName to pass into the sub for AaA Starts that I wish to call once the Starts code has compiled.

 

[Andrew Poulsom]

I don't see that it will make any difference.

 

[Mr Denove]

Thanks Andrew, now off a conference call so will make the amendment and see how it goes.