Drzemlik
Drzemlik

Reputation: 59

MsgBox with list of files changed by a macro (files chosen with FileDialog)

The code below lets user to pick the files in a folder and makes some corrections of values in the chosen Excel files. The idea is to have MsgBox popping up with the list of files that have just been corrected by the macro, so the user knew which of files has been changed (i.e. had some cells marked with yellow color).

I suppose that I should set some variable that would collect all the names to be displayed in MsgBox, but I can't figure out how to do that. Could you give me some ideas how to solve this problem?

Sub FixCSV()

Dim wrk As Workbook
Dim Sh As Worksheet
Dim i As Long, j As Long, k As Long, lastRow As Long, lastColumn As Long
Dim chosenFile As Integer
Dim xlFileName As String
Dim chooseFiles As Office.FileDialog


Set chooseFiles = Application.FileDialog(msoFileDialogFilePicker)

    With chooseFiles      
        .AllowMultiSelect = True
        .Title = "Please select the file."
        .InitialFileName = "c:\"
        .InitialView = msoFileDialogViewList
        .Filters.Add "All", "*.*"         
    End With


If chooseFiles.Show = -1 Then
    For k = 1 To chooseFiles.SelectedItems.Count
        xlFileName = chooseFiles.SelectedItems(k)
        Workbooks.Open chooseFiles.SelectedItems(k)

        Set wrk = Workbooks.Open(xlFileName)
        Set Sh = wrk.Worksheets(1)

        lastRow = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row
        lastColumn = Sh.Cells(1, Sh.Columns.Count).End(xlToLeft).Column


        i = 2

        Do Until i = lastRow
            If Sh.Cells(i, lastColumn).Offset(0, 1).Value <> "" Then 

              'do sth to correct values
              Sh.Cells(i, 1).Resize(1, lastColumn + 5).Interior.ColorIndex = 6

              Else             
                 i = i + 1
            End If
        Loop

    wrk.Close SaveChanges:=true

    Next k
End If

End Sub

Upvotes: 0

Views: 101

Answers (1)

user10970498
user10970498

Reputation:

Add a dictionary object for a unique list of workbooks or workbooks and worksheets that have been changed.

Sub FixCSV()

    Dim wrk As Workbook
    Dim Sh As Worksheet
    Dim i As Long, j As Long, k As Long, lastRow As Long, lastColumn As Long
    Dim chosenFile As Integer
    Dim xlFileName As String
    Dim chooseFiles As Office.FileDialog
    DIM DICT AS OBJECT

    SET DICT = CREATEOBJECT("SCRIPTING.DICTIONARY")


    Set chooseFiles = Application.FileDialog(msoFileDialogFilePicker)

    With chooseFiles      
        .AllowMultiSelect = True
        .Title = "Please select the file."
        .InitialFileName = "c:\"
        .InitialView = msoFileDialogViewList
        '.Filters.Add "Custom Excel Files", "*.xlsx, *.csv, *.xls"
        .Filters.Add "All", "*.*"         
    End With

    If chooseFiles.Show = -1 Then
        For k = 1 To chooseFiles.SelectedItems.Count
            xlFileName = chooseFiles.SelectedItems(k)
            Workbooks.Open chooseFiles.SelectedItems(k)

            Set wrk = Workbooks.Open(xlFileName)
            Set Sh = wrk.Worksheets(1)

            lastRow = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row
            lastColumn = Sh.Cells(1, Sh.Columns.Count).End(xlToLeft).Column


            i = 2

            Do Until i = lastRow
                If Sh.Cells(i, lastColumn).Offset(0, 1).Value <> "" Then 

                    'do sth to correct values
                    Sh.Cells(i, 1).Resize(1, lastColumn + 5).Interior.ColorIndex = 6
                    DICT.ITEM(WRK.NAME & "." & SH.NAME) = VBNULLSTRING
                Else             
                     i = i + 1
                End If
            Loop

        wrk.Close SaveChanges:=true

        Next k
    End If

    IF DICT.COUNT > 0 THEN MSGBOX JOIN(DICT.KEYS, VBLF) & VBLF & " HAVE BEEN CHANGED."

End Sub

Upvotes: 0

Related Questions