-
5 Attachment(s)
Vba - Check String/Text From Multiple Workbook Without Opening All Files
-
2 Attachment(s)
Hello Muhammad
We can, with Excel, do a couple of very simple things on closed workbooks.
_1 Get values from the cells
_2 Use the closed workbook ranges in some Excel formulas
There are also more advanced things that can be done
I will initially do a simple solution,
Simple Solution _1
We can get for example the value in cell B6 in Sheet1 of data_1555.xlsx with a closed workbook referrence formula like of this form
='C:\AFolder\Target\[data_1555.xlsx]Sheet1'!$B$6
we may now change that to a relative reference, or “fixed vector” formula thus
='C:\AFolder\Target\[data_1555.xlsx]Sheet1'!B6
which can then be applied across a multi cell range to return us all the values from a range. It will keep its relative cell value position. For convenience we can apply this over a temporary range of the same size as the data range. This will effectively import the values from the closed workbook data range into the temporary range
Once we have those values, we can think of a way to check to see if they are all empty. Just one example would be to count how many 0s **( For this solution it would assume that you do not have any cells filled with a 0 )
(**A closed workbook referrence formula will return a 0 if applied to an empty cell in a closed workbook)
I assume that all worksheets are named Sheet1. I also need to know the workbook names, but we can get those in a loop using the Dir function, to loop for all files in a folder.
I will write the macro in a file, OpenBook.xls, which I will initially assume is also in the same folder , ( your Target folder )
Macro:
Code:
Option Explicit
Sub Solution_1() ' https://excelfox.com/forum/showthread.php/2780-Vba-Check-String-Text-From-Multiple-Workbook-Without-Opening-All-Files?p=16337&viewfull=1#post16337
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = ThisWorkbook.Worksheets.Item(1) ' first woprksheet item - first tab counting from the left
Dim rngTemp As Range: Set rngTemp = Ws.Range("B6:O11") ' Any range of the size of the data range, (ex A1:B6 is just as good). We temporarily put our velues from the closed workbook data range here for each workbook we find with Dir
Dim Pth As String: Let Pth = ThisWorkbook.Path ' YOU MAY WANT TO CHANGE THIS ####
Rem 2 loop all files at Pth
Dim FileName As String
Let FileName = Dir(Pth & "\*.xlsx", vbNormal) ' this will return the next file meeting path and search criteria Pth & "\xxxxxxxxxxxx.xlsx"
Do While FileName <> "" ' Dir will only look once in a folder, progresively going down the list, and it will return "" once it finds no more files meeting the criteria Pth & "\xxxxxxxxxxxx.xlsx"
If FileName <> ThisWorkbook.Name Then ' YOU MAY NOT NEED THIS IF this file is not in the same folder ####
' like "='C:\..\Target\[data_1555.xlsx]Sheet1'!B6 "
Let rngTemp.Value2 = "='" & Pth & "\[" & FileName & "]Sheet1'!B6" ' put the values from the data range in the closed book temporarily in the temporary range of this workbook
Dim Cnt As Long: Let Cnt = Application.WorksheetFunction.CountIf(Ws.Range("B6:O11"), 0) ' The closed workbook referrence formula in the last line will return a 0 for empty cells.
If Cnt = 84 Then ' The data range has 84 cells, so if all are empty the closed workbook referrence formula will give all 84 cells value as 0
' if we have 84 cells with 0 in, then there are no cell values in the range
Else
' if we did not count 84 0s then we must have some filled cells
Dim OutMsg As String, CntOut As Long
Let OutMsg = OutMsg & FileName & vbCr & vbLf: Let CntOut = CntOut + 1 ' add file name to output messag foolowe by new line : increas count of workbooks with some data in
End If
Else ' ' YOU MAY NOT NEED THIS IF this file is not in the same folder ####
' we found this workbook using Dir ,so we ignore it
End If ' ' YOU MAY NOT NEED THIS IF this file is not in the same folder ####
Let FileName = Dir ' if I use Dir on its own without stuff in ( ) then it uses last search criteria again and looks for next file meeting path criteria Pth & "\xxxxxxxxxxxx.xlsx"
Loop ' Do While FileName <> ""
Rem 3 Outpout message
If Cnt = 0 Then
MsgBox prompt:="All files are empty of data"
Else
MsgBox prompt:="Founded " & CntOut & " unempty files, with names" & vbCr & vbLf & OutMsg
End If
End Sub
To test: Put file, OpenBook.xls , in same folder as test files ( in your Target folder )
Run macro Sub Solution_1()
Using you test results, should give:
Attachment 3816
Alan
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgxUbeYSvsBH2Gianox4AaABAg. 9VYH-07VTyW9gJV5fDAZNe
https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgxLtKj969oiIu7zNb94AaABAg
https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgyhQ73u0C3V4bEPhYB4AaABAg
https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgzIElpI5OFExnUyrk14AaABAg. 9fsvd9zwZii9gMUka-NbIZ
https://www.youtube.com/watch?v=jdPeMPT98QU
https://www.youtube.com/watch?v=QdwDnUz96W0&lc=Ugx3syV3Bw6bxddVyBx4AaABAg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
-
hi.. DocAElstein.
thank you so much!!! Brilliant, Working great!!
Quote:
Originally Posted by
muhammad susanto
hi.. DocAElstein.
thank you so much!!! Brilliant, Working great!!
OK, yous welcome, thanks for the feedback :)
Alan
-
Late in the day, I know. This one looks for strings only (numbers are ignored) in that range:
Code:
Sub blah()
Set fs = CreateObject("Scripting.FileSystemObject")
Pth = "D:\Target"
Set f = fs.GetFolder(Pth)
For Each wb In f.Files
If InStr(1, wb.Type, "Excel", vbTextCompare) > 0 Then
With Range("C4") 'use a cell where it doesn't matter
.Formula2R1C1 = "=SUMPRODUCT(--ISTEXT('" & Pth & "\[" & wb.Name & "]Sheet1'!R6C1:R11C15))"
If .Value > 0 Then If Len(msg) = 0 Then msg = wb.Name Else msg = msg & vbLf & wb.Name
.Clear
End With
End If
Next wb
If Len(msg) > 0 Then
MsgBox "Workbooks containing any string in range B6:O11 are:" & vbLf & msg
Else
MsgBox "None found"
End If
End Sub
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
-
Its never late here, Pascal, - furthering the subject at any time is what we’re about, :)
I actually wanted to try at a solution like yours, but I am not so well clued up generally on formulas, and I am not so sure which ones work on closed workbooks. Some don’t for some reason I don’t know yet.
But I expected a solution like you did might be a bit more efficient as you just use a temporary cell rather than a temporary range as mine did.
(You got a small typo I think, .Formula2R1C1 should be .FormulaR1C1)
( I always use .Value when I put a formula into a cell with coding. Its just a personal preference based on a (very likely dodgy) “Alan theory” that .Value applied to a cell in coding is seen as if you type stuff in manually in the spreadsheet, and the thing telling Excel it's a formula is the _"="_, just as it would be if you typed it in manually in the spreadsheet
.FormulaR1C1 is probably the more better and correct way, but I like to indulge in my fantasy theories, :) )
Alan
Code:
' Pascal https://excelfox.com/forum/showthread.php/2780-Vba-Check-String-Text-From-Multiple-Workbook-Without-Opening-All-Files?p=16356&viewfull=1#post16356
Sub blah()
Dim Fs As Object, Pth As String, F As Variant, Wb As Object, Msg As String
Set Fs = CreateObject("Scripting.FileSystemObject")
Let Pth = ThisWorkbook.Path '"D:\Target"
Set F = Fs.GetFolder(Pth)
For Each Wb In F.Files
If InStr(1, Wb.Type, "Excel", vbTextCompare) > 0 Then
With Range("C4") 'use a cell where it doesn't matter
'.FormulaR1C1 = "=SUMPRODUCT(--ISTEXT('" & Pth & "\[" & Wb.Name & "]Sheet1'!R6C1:R11C15))"
.Value = "=SUMPRODUCT(--ISTEXT('" & Pth & "\[" & Wb.Name & "]Sheet1'!R6C1:R11C15))"
If .Value > 0 Then If Len(Msg) = 0 Then Msg = Wb.Name Else Msg = Msg & vbLf & Wb.Name
.Clear
End With
End If
Next Wb
If Len(Msg) > 0 Then
MsgBox "Workbooks containing any string in range B6:O11 are:" & vbLf & Msg
Else
MsgBox "None found"
End If
End Sub
