Copy from another workbook based on data in a column

Hi everyone, I require a vba code where if in workbook "Summary", sheet "Report" column "E" = orange, apple and cherry then take the sum total from "F" and input that total into another workbook "Report", sheet "Total" in column "E7".
Thanks

Originally Posted by Arkadi

Biznez,

Hi again. Which book would the code reside in? Also you are saying that for all used range of column E, if E has "orange", or "apple" or "cherry" then add the F value to a total, and that total is then put in "Report"?

Hey Arkadi, yes the code would reside in workbook "Report" sheet "Total"

Originally Posted by Arkadi

Not too fancy, but will do the trick:

Sub biznez_5()

Dim wb As Workbook
Dim ws As Worksheet
Dim lr As Long
Dim i As Long
Dim ftotal As Long
Dim fname As String
Dim myArr As Variant

Application.ScreenUpdating = False
myArr = Array("apple", "orange", "cherry") 'values that we will match against
fname = "c:\summary.xlsx" 'change to path and proper extension... xlsm, xlsx?
Set wb = Workbooks.Open(fname)
Set ws = wb.Worksheets("Report")
lr = ws.Range("E" & Rows.Count).End(xlUp).Row
ftotal = 0
For i = 1 To lr
    If UBound(Filter(myArr, ws.Range("E" & i))) > -1 Then ftotal = ftotal + ws.Range("F" & i)
Next i
wb.Close
Worksheets("Total").Range("E7").Value = ftotal
Application.ScreenUpdating = True

End Sub

Hi Arkadi, the file summary.xlsx will always be open. is the path c:\summary.xlsx necessary cuz this file is opened by explorer in excel format so i dont think it would have a path.

How can this code work if i have additional data in column E in workbook Summary and instead of putting the total in E7, it puts it in E8?

for example, also looks for "Cat, dog, lion" and puts that total in E8?

Getting error 'Run-time error '9' Subscript out of range on the red line below

Sub biznez_5()

Dim wb As Workbook
dim wb2 as workbook
Dim ws As Worksheet
Dim lr As Long
Dim i As Long
Dim ftotal As Long
dim ftotal2 as Long
Dim myArr As Variant
Dim myArr2 As Variant

Application.ScreenUpdating = False
myArr = Array("apple", "orange", "cherry") 'values that we will match against
myArr2 = Array("cat","dog","lion")
set wb2 = thisworkbook
Set wb = Workbooks("summary.xlsx")
Set ws = wb.Worksheets("Report")
lr = ws.Range("E" & Rows.Count).End(xlUp).Row
ftotal = 0
ftotal 2 = 0
For i = 1 To lr
    If UBound(Filter(myArr, ws.Range("E" & i))) > -1 Then ftotal = ftotal + ws.Range("F" & i)
    If UBound(Filter(myArr2, ws.Range("E" & i))) > -1 Then ftotal2 = ftotal2 + ws.Range("F" & i)
Next i
wb2.Worksheets("Total").Range("E7").Value = ftotal
wb2.Worksheets("Total").Range("E8").Value = ftotal2
Application.ScreenUpdating = True

End Sub

ok now i saved it as xlsx and it still getting that same error message

its open and on the header it says "Summary [Compatibility Mode]. Its not saved anywhere as i extracted it from an external application.

Originally Posted by Arkadi

I'm not sure how exactly you reference it, try just "Summary" without extension, or go into vba editor make a module in the Summary workbook, and make a sub with one line:

msgbox thisworkbook.name

It should return the name of the book as it is in that condition.

Summary.xlsx is what i got

yes its open

nows im getting

Run-time error '1004': Method 'Range' of object '_worksheet' failed

Dim wb As Workbook
dim wb2 as workbook
Dim ws As Worksheet
Dim lr As Long
Dim i As Long
Dim ftotal As Long
dim ftotal2 as Long
Dim myArr As Variant
Dim myArr2 As Variant

Application.ScreenUpdating = False
myArr = Array("apple", "orange", "cherry") 'values that we will match against
myArr2 = Array("cat","dog","lion")
set wb2 = thisworkbook
Set wb = Workbooks("summary.xlsx")
Set ws = wb.Worksheets("Report")
lr = ws.Range("E" & Rows.Count).End(xlUp).Row
ftotal = 0
ftotal 2 = 0
For i = 1 To lr
    If UBound(Filter(myArr, ws.Range("E" & i))) > -1 Then ftotal = ftotal + ws.Range("F" & i)
    If UBound(Filter(myArr2, ws.Range("E" & i))) > -1 Then ftotal2 = ftotal2 + ws.Range("F" & i)
Next i
wb2.Worksheets("Total").Range("E7").Value = ftotal
wb2.Worksheets("Total").Range("E8").Value = ftotal2
Application.ScreenUpdating = True

Originally Posted by Arkadi

Ok, how did you get past the first error?

As for the new error... does the sheet "Report" exist in the "Summary" workbook? and does it have data?

Hi Arkadi, is there any simpler way of writing this code?

Originally Posted by Arkadi

What part are you trying to simplify? Is it that you are getting errors on and off, or having trouble adapting it, or something else? Just trying to understand what your concern is so I can do my best to help accordingly

still stuck at the error at "Set wb = Workbooks("Summary.xlsx")"
getting error subscript out of range. not sure why this is happening when the file is already opened

Originally Posted by Arkadi

you said before that summary is a workbook extracted from an external application... is it still that way, or is it a saved book at this point?
Can you upload the report workbook, and if summary is a saved one now, maybe also that one?

summary is a workbook extracted from an external application (access software). The actual file name is Summary_Batch_RPT1.xlsx

In addition. When the summary file is extracted, it opens new excel application. A whole new workbook. Maybe thats the issue. This code does not connect with the other new excel. Perhaps?