Reputation: 59
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
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