Excel VBA - Return to the sheet the Macro was called from

[Trent452]

Hi All

I have a problem with my code. I need to call on a .csv file, format it, select a specific dynamic range and paste it in the sheet the macro was called from.

I managed most of the above, however, i can't get it back to the sheet the macro was called from.

I have tried multiple options, but it either gives me an error or break the code.

Sub GetCSVList()Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(msoFileDialogFilePicker)
With dlgOpen
    .AllowMultiSelect = True
    ''Start in
    .InitialFileName = "C:\Test"
    .Show
End With


For Each fname In dlgOpen.SelectedItems
    ImportCSV fname
Next
End Sub






Sub ImportCSV(fname)
Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
ws.Name = "test" & Worksheets.Count + 1


With ws.QueryTables.Add( _
        Connection:="TEXT;" & fname, _
        Destination:=Range("A1"))
    .Name = "Test" & Worksheets.Count + 1
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 65001
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .Refresh BackgroundQuery:=False
    '.UseListObject = False
End With


Dim ws1 As Worksheet
    Set ws1 = ThisWorkbook.Worksheets(ws.Name)


    Dim LastRow As Long
    LastRow = ws1.Evaluate("=LOOKUP(2,1/(I:I>0), ROW(I:I))")


    Dim CopyRange As Range
    Set CopyRange = ws1.Range("A1", ws.Cells(LastRow, "I"))
    CopyRange.Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.NumberFormat = "0.0"
    Selection.NumberFormat = "0.00"
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Replace What:="0", Replacement:="N/D", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Copy
    Debug.Print CopyRange.Address
    Call sourceSheet.Activate


End Sub

Above is the code I am currently using and my last attempt.

Any and all help will be appreciated.

Thank you.

 

[Norie]

Try changing the sub GetCSVList to this.

Sub GetCSVList()
Dim sourceSheet As Worksheet
Dim dlgOpen As FileDialog

    Set sourceSheet = ActiveSheet

    Set dlgOpen = Application.FileDialog(msoFileDialogFilePicker)
    With dlgOpen
        .AllowMultiSelect = True
        ''Start in
        .InitialFileName = "C:\Test"
        .Show
    End With


    For Each fname In dlgOpen.SelectedItems
        ImportCSV fname
    Next

    Application.Goto sourceSheet.Range("A1"), Scroll:=True

End Sub

Also, try changing the sub ImportCSV to this.

Sub ImportCSV(fname)
Dim ws1 As Worksheet
Dim LastRow As Long
Dim CopyRange As Range

    Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    
    ws.Name = "test" & Worksheets.Count + 1

    With ws.QueryTables.Add( _
        Connection:="TEXT;" & fname, _
        Destination:=Range("A1"))
        .Name = "Test" & Worksheets.Count + 1
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .Refresh BackgroundQuery:=False
        '.UseListObject = False
    End With

    LastRow = ws.Evaluate("=LOOKUP(2,1/(I:I>0), ROW(I:I))")

    Set CopyRange = ws.Range("A1", ws.Cells(LastRow, "I"))
    
    CopyRange.Select
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.NumberFormat = "0.0"
    Selection.NumberFormat = "0.00"
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Replace What:="0", Replacement:="N/D", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Copy
        
End Sub

 

[Trent452]

Wow! That was quick. Thank you so much. Worked perfectly.