Compiles but does not Paste Data Over to the MAG Pivot Version.Help Please

Mr Denove

Active Member
Joined
Jun 8, 2007
Messages
446
Code:
Sub CopyAndMoveThisWorks()
    Dim FName As Variant
    FName = Application.GetOpenFilename("N:\SEEL\nsb 2\Reports - Monthly\NTP Performance Reports - Backup Data\2013-14\(*.xlsx), *.xlsx", Title:="Select File To Be Opened")
    If FName = False Then
        Exit Sub
    Else
        Workbooks.Open FName
        End If
    End Sub
 
Sub CWN()
Dim sh As Worksheet
Dim TxtRng  As Range
Application.EnableEvents = False
For Each sh In Worksheets(Array("Starts", "Leavers (incl SSMA Prog)", "In-training", "Achievements"))
    With sh
        .Select
        .Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("A2:A" & .Cells(Rows.Count, "B").End(xlUp).Row).Value = .Name
        
        Set TxtRng = sh.Range("A1")
        TxtRng.Value = "Category"
        
    End With
Next sh

Application.EnableEvents = True
 
    SG_MoveColumns ("Starts")
    SG_MoveColumns ("Leavers (incl SSMA Prog)")
    SG_MoveColumns ("In-training")
    SG_MoveColumns ("Achievements")
    ThisWorkbook.Activate
    MsgBox "All done."

End Sub

Sub SG_MoveColumns(sSheetname As String)

    Dim src As Worksheet    'NTP Performance Reports - Backup Data\2013-14\NTP Performance Report 2013-14 Period 6 September - Data.xlsx
    Dim srcLastRow As Double
    Dim srcLastCol As Double
    Dim tgt As Worksheet    'Data   in MAG Pivot Version Copy
    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("MAG Pivot Version.xlsm").Worksheets("Data")
    tgtLastRow = tgt.Cells(Rows.Count, 2).End(xlUp).Row

    ' Selects the columns to be copied
    myColumns = Array("Category", "Assignment id", "Trainee district desc", "Gender", "Age Band", "VQ Level", "Updated programme", "Provider", "Updated Employer")
    
    ' 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

This is the fruits of my labour for too many days and Im now at the last wee bit. I just want the columns to now paste over to the MAG Pivot file.

Can someone please point out the reason why its not doing so?
Oh, and why isnt the folder path working? It just goes to whatever the last folder opened was.
Thanks in advance
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
It looks like Ive fixed it by removing the first End Sub followed by the Sub CWN.

However I would still the path to the folder to be Hardcoded as the folder wont change but the file name being selected does.
 
Upvote 0

Forum statistics

Threads
1,225,739
Messages
6,186,738
Members
453,369
Latest member
juliewar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top