I am trying to sort the exercise, in which the auto summarize data will be copied straight to the cell related from the input-based cell in the row.
In the first sheet I have the results of my search across all workbooks in the directory applying the string (code) 4008 in the input.
Next I would like to autosum all these values in the first cell after the last row under E column and paste it directly to the cell, which corresponds to the row, where the code 4008 can be found.
My code looks like this:
Sub SearchFolders()
Dim wbAct As Workbook, pathMainWb As String, fldrPath As String
Dim bom As String, scrUpdt, WsOut As Worksheet, colFiles As Collection, f As Object
Dim xBol As Boolean, wb As Workbook, ws As Worksheet, arrWs
Dim matchedCells As Collection, Cell, numHits As Long, summRow As Long
Set wbAct = ActiveWorkbook
pathMainWb = wbAct.FullName '<<<<
On Error GoTo ErrHandler
fldrPath = UserSelectFolder("Select a folder")
If Len(fldrPath) = 0 Then Exit Sub
'get all files in the selected folder
Set colFiles = GetFileMatches(fldrPath, "*.xls*", False) 'False=no subfolders
If colFiles.Count = 0 Then
MsgBox "No Excel files found in selected folder"
Exit Sub
End If
bom = InputBox("Please provide the Code")
scrUpdt = Application.ScreenUpdating
Application.ScreenUpdating = False
Set WsOut = ThisWorkbook.Worksheets("SUMMARY")
summRow = 1
'sheet names to scan
arrWs = Array("Civils Work Order", "Cable Work Order", "BoM")
WsOut.Cells(summRow, 1).Resize(1, 5).Value = Array("Workbook", "Worksheet", _
"Cell", "Text in Cell", "Values corresponding")
For Each f In colFiles
xBol = (f.Path = pathMainWb) 'file already open?
If xBol Then
Set wb = wbAct
Else
Set wb = Workbooks.Open(Filename:=f.Path, UpdateLinks:=0, _
ReadOnly:=True, AddToMRU:=False)
End If
For Each ws In wb.Worksheets
'are we interested in this sheet?
If Not IsError(Application.Match(ws.Name, arrWs, 0)) Then
Set matchedCells = FindAll(ws.UsedRange, bom) 'get all cells with bom
If matchedCells.Count > 0 Then
For Each Cell In matchedCells
summRow = summRow + 1
WsOut.Cells(summRow, 1).Resize(1, 5).Value = _
Array(wb.Name, ws.Name, Cell.Address, Cell.Value, _
Cell.EntireRow.Range("F1").Value)
numHits = numHits + 1
Next Cell 'next match
End If 'any bom matches
End If 'matched sheet name
Next ws
If Not xBol Then wb.Close False 'need to close this workbook?
Next f
With WsOut
Dim lastRow As Long
.Columns("A:E").EntireColumn.AutoFit
lastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
.Range("E" & lastRow + 1).Value = WorksheetFunction.Sum(Range("E2:E" & lastRow + 1))
ThisWorkbook.Worksheets("Test").Range("I1").Value = .Range("E" & lastRow + 1).Value
For i = 2 To Excel.WorksheetFunction.CountA(Range("A:A"))
If Range("A" & i).Value = bom Then
Range("F" & i).Value = WsOut.Range("E" & lastRow + 1).Value
End If
Next i
End With
MsgBox numHits & " cells have been found", , "Calculator"
ExitHandler:
Application.ScreenUpdating = scrUpdt
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Sub
The first question is:
ActiveSheet
? (following this thread Can't copy value from the Last Row to other worksheet ) Is there a chance to make this value copied directly to the cell appropriat for the given code applied?
When you're using application functions or things like that, even while using With WsOut... End With
you need to keep using the indirect reference (I don't know the correct terminology) with .Range
instead of the normal Range
Sub testSum()
Dim wb As Workbook: Set wb = Workbooks("MOSTEST.xlsx")
Dim ws As Worksheet: Set ws = wb.Sheets("Testsheet")
ws.Range("C39").Value = WorksheetFunction.Sum(ws.Range("C29:C38")) 'Not just Range()
MsgBox ("The sum is = " & ws.Range("C39").Value)
ws.Range("C39").Clear
With ws
.Range("C39").Value = WorksheetFunction.Sum(.Range("C29:C38")) 'Not just Range()
MsgBox ("The sum is = " & .Range("C39").Value)
End With
End Sub
Both of these work just fine even if the workbook isn't active.
So in your case if you change
.Range("E" & lastRow + 1).Value = WorksheetFunction.Sum(Range("E2:E" & lastRow + 1))
'into
.Range("E" & lastRow + 1).Value = WorksheetFunction.Sum(.Range("E2:E" & lastRow + 1))
it should work as intended:)
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.