Hello,
I would adapt code to deal with amounts don't contain comma, dot are existed in files names .
sometimes I have files names like this
BBG 1000 MM
VVVV 100 BB
and the code deal just with this
QWE TY 8,000.00
ZE 400.00
so I would also deal with files names don't contain comma, dot when rename files again
to know what code does it
and here is original thread
http://www.vbaexpress.com/forum/show...n-file-is-open
here is code
 
Sub test()    Dim myDir As String, temp(), myList
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1)
    End With
    If myDir = "" Then Exit Sub
    myList = SearchFiles(myDir, 0, temp())
    If IsError(myList) Then MsgBox "No file found": Exit Sub
    DoIt myList
End Sub
 
Private Function SearchFiles(myDir$, n&, myList)
    Dim fso As Object, myFolder As Object, myFile As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each myFile In fso.getfolder(myDir).Files
        If (Not myFile.Name Like "~$*") * (UCase$(myFile.Name) Like UCase$("*.xls*")) Then
            n = n + 1
            ReDim Preserve myList(1 To 2, 1 To n)
            myList(1, n) = myDir & "\"
            myList(2, n) = myFile.Name
        End If
    Next
    For Each myFolder In fso.getfolder(myDir).subfolders
        SearchFiles = SearchFiles(myFolder.Path, n, myList)
    Next
    SearchFiles = IIf(n > 0, myList, CVErr(xlErrRef))
End Function




Sub DoIt(ByVal myList)
    Dim i&, fn$, myAmount$, wsName$, s$, x, msg$, g
    For i = 1 To UBound(myList, 2)
        fn = myList(1, i) & myList(2, i)
        If fn <> ThisWorkbook.FullName Then
            myAmount = GetAmount(CStr(myList(2, i)))
            If myAmount Like "*#.00" Then
                wsName = GetWsName(fn)
                s = "'" & myList(1, i) & "[" & myList(2, i) & "]" & wsName & "'!"
                x = ExecuteExcel4Macro("match(""total""," & s & "c5:c5,0)")
                If Not IsError(x) Then
                    g = ExecuteExcel4Macro(s & "r" & x & "c7")
                    x = ExecuteExcel4Macro("sum(" & s & "r9c7:r" & x - 1 & "c7)")
                    If myAmount <> Format$(x, "#,###.00") Then
                         s = myList(1, i) & Replace(myList(2, i), myAmount, x)
                        If Dir(s) = "" Then
                            Name fn As myList(1, i) & Replace(myList(2, i), myAmount, Format$(x, "#,###.00"))
                        Else
                            msg = msg & vbLf & Replace(myList(2, i), myAmount, Format$(x, "#,###.00")) & vbLf & _
                                " is already exists in the same folder"
                        End If
                                " is already exists in the same folder"
                        End If
                    End If
                End If
            End If
        End If
    Next
    If Len(msg) Then MsgBox msg
End Sub


Function GetWsName$(fn$)
    GetWsName = Replace(CreateObject("DAO.DBEngine.120").OpenDatabase(fn, _
                         False, False, "excel 5.0;hdr=no;").tabledefs(0).Name, "$", "")
End Function


Function GetAmount$(fn$)
    With CreateObject("VBScript.RegExp")
        .Pattern = "\b\d{1,3}(,\d{3})*\.00*\b"
        If .test(fn) Then GetAmount = .Execute(fn)(0)
    End With
End Function


Sub UpdateAmount(fn$, wsName$, myAmount)
    Dim s$
    s = "Update `" & wsName & "$E8:G` Set `Balance` = " & myAmount & " Where `C#N` = 'TOTAL';"
    With CreateObject("ADODB.Connection")
        .Provider = "Microsoft.Ace.OLEDB.12.0"
        .Properties("Extended Properties") = "Excel 8.0"
        .Open fn
        .Execute s
    End With

End Sub

thanks in advanced