Little help on Autofill please

[James8309]

Hi, everyone.

I am having difficulties trying to fit in Autofill codes in between my
sumif macro.

My sumif macro works fine and it does;

1. Open up correct data workbook from specific directory then.

2. Do a sumif in each cell Range from B7:AO7 to the Last row that
contains data with criteria on column A

3. Close data workbook.

Basically it opens up a correct file, perform a sumif then close
workbook. I am just trying to fit 'Autofill' in. so instead of closing
the data workbook straight away after performing sumif in each cell,
it does autofill for that column then closes the workbook.

Where do I squeeze the autofill in? I was thinking after the
"CELL.Value =
Application.WorksheetFunction.SumIf(WB.Sheets("Sheet1").Range("H:U"),
SUMREF, WB.Sheets("Sheet1").Range("U:U"))" line.


Sub Test3()

Dim CELL As Range
Dim LR As Integer
Dim MYPATH As String
Dim WB As Workbook
Dim MYREF As String
Dim SUMREF As String
Dim Lastrow As Long
Dim WS As Worksheet
MYPATH = "C:\Mydocuments\ABC\"
LR = Range("A65000").End(xlUp).Row
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row

For Each CELL In Range("B6:AO6")
CELL.Select
SUMREF = Range("A" & CELL.Row).Value
CELL.Interior.ColorIndex = 25
MYPATH = MYPATH & Range("A1").Value & "\" & Year(Cells(5,
ActiveCell.Column).Value) & "\" _
& Format(Cells(5, ActiveCell.Column).Value, "MMM YY")
Debug.Print MYPATH
MYREF = MYPATH & ".xls"
Workbooks.Open Filename:=MYREF
Debug.Print MYREF
Set WB = ActiveWorkbook
CELL.Value =
Application.WorksheetFunction.SumIf(WB.Sheets("Sheet1").Range("H:U"),
SUMREF, WB.Sheets("Sheet1").Range("U:U"))

MYPATH = "C:\Mydocuments\ABC\"
WB.Close
Next

End Sub

 

[Joel]

Sub Test3()

Dim CELL As Range
Dim LR As Integer
Dim MYPATH As String
Dim WB As Workbook
Dim MYREF As String
Dim SUMREF As String
Dim Lastrow As Long
Dim WS As Worksheet
Folder = "C:\Mydocuments\ABC\"
Lastrow = Range("A" & Rows.Count).End(xlUp).Row

For RowCount = 6 To Lastrow
For Each CELL In Range("B" & RowCount & ":AO" & RowCount)
SUMREF = CELL.Offset(0, -1)
CELL.Interior.ColorIndex = 25
MYPATH = Folder & Range("A1").Value & "\" & _
Year(Cells(5, CELL.Column).Value) & "\" _
& Format(Cells(5, CELL.Column).Value, "MMM YY")
Debug.Print MYPATH
MYREF = MYPATH & ".xls"
Workbooks.Open Filename:=MYREF
Debug.Print MYREF
Set WB = ActiveWorkbook
CELL.Value = _
Application.WorksheetFunction.SumIf( _
WB.Sheets("Sheet1").Range("H:U"), _
SUMREF, _
WB.Sheets("Sheet1").Range("U:U"))
WB.Close
Next CELL
Next RowCount

End Sub

 

[James8309]

Sub Test3()

Dim CELL As Range
Dim LR As Integer
Dim MYPATH As String
Dim WB As Workbook
Dim MYREF As String
Dim SUMREF As String
Dim Lastrow As Long
Dim WS As Worksheet
Folder = "C:\Mydocuments\ABC\"
Lastrow = Range("A" & Rows.Count).End(xlUp).Row

For RowCount = 6 To Lastrow
   For Each CELL In Range("B" & RowCount & ":AO" & RowCount)
      SUMREF = CELL.Offset(0, -1)
      CELL.Interior.ColorIndex = 25
      MYPATH = Folder & Range("A1").Value & "\" & _
         Year(Cells(5, CELL.Column).Value) & "\" _
         & Format(Cells(5, CELL.Column).Value, "MMM YY")
      Debug.Print MYPATH
      MYREF = MYPATH & ".xls"
      Workbooks.Open Filename:=MYREF
      Debug.Print MYREF
      Set WB = ActiveWorkbook
      CELL.Value = _
         Application.WorksheetFunction.SumIf( _
            WB.Sheets("Sheet1").Range("H:U"), _
            SUMREF, _
            WB.Sheets("Sheet1").Range("U:U"))
      WB.Close
   Next CELL
Next RowCount

End Sub

















- Show quoted text -

It still calculates sum for each cell 'one by one' and it takes too
long.

Is it possible to do a sumif on one cell then autofill(autocalculate)
the whole row to the last row? then close workbook?

i.e. if Column A has values from A6 to A100, in Cell B6, it will open
up data workbook, perform a sumif then autofill from B6 to B100 then
close workbook. Same process through B to AO

 

[Joel]

when you use a worksheet function from VBA it take the same time to run as if
you put the function on the worksheet try this code instead

Sub Test3()

Dim CELL As Range
Dim LR As Integer
Dim MYPATH As String
Dim WB As Workbook
Dim MYREF As String
Dim SUMREF As String
Dim Lastrow As Long
Dim WS As Worksheet
Folder = "C:\Mydocuments\ABC\"
Lastrow = Range("A" & Rows.Count).End(xlUp).Row

For RowCount = 6 To Lastrow
For Each CELL In Range("B" & RowCount & ":AO" & RowCount)
SUMREF = CELL.Offset(0, -1)
CELL.Interior.ColorIndex = 25
MYPATH = Folder & Range("A1").Value & "\" & _
Year(Cells(5, CELL.Column).Value) & "\" _
& Format(Cells(5, CELL.Column).Value, "MMM YY")
Debug.Print MYPATH
MYREF = MYPATH & ".xls"
Workbooks.Open Filename:=MYREF
Debug.Print MYREF
Set WB = ActiveWorkbook
subtotal = 0
for each T_Cell in WB.Sheets("Sheet1"). _
Range("H" & Rowcount & ":U" & Rowcount)
if T_Cell.value = SUMREF then
subtotal = subtotal + T_Cell.value
end if
next T_Cell
CELL.Value = subtotal
WB.Close
Next CELL
Next RowCount

End Sub

 

[James8309]

when you use a worksheet function from VBA it take the same time to run asif
you put the function on the worksheet try this code instead

Sub Test3()

Dim CELL As Range
Dim LR As Integer
Dim MYPATH As String
Dim WB As Workbook
Dim MYREF As String
Dim SUMREF As String
Dim Lastrow As Long
Dim WS As Worksheet
Folder = "C:\Mydocuments\ABC\"
Lastrow = Range("A" & Rows.Count).End(xlUp).Row

For RowCount = 6 To Lastrow
   For Each CELL In Range("B" & RowCount & ":AO" & RowCount)
      SUMREF = CELL.Offset(0, -1)
      CELL.Interior.ColorIndex = 25
      MYPATH = Folder & Range("A1").Value & "\" & _
         Year(Cells(5, CELL.Column).Value) & "\" _
         & Format(Cells(5, CELL.Column).Value, "MMM YY")
      Debug.Print MYPATH
      MYREF = MYPATH & ".xls"
      Workbooks.Open Filename:=MYREF
      Debug.Print MYREF
      Set WB = ActiveWorkbook
      subtotal = 0
      for each T_Cell in WB.Sheets("Sheet1"). _
         Range("H" & Rowcount & ":U" & Rowcount)
         if T_Cell.value = SUMREF then
            subtotal = subtotal + T_Cell.value
         end if
      next T_Cell
      CELL.Value = subtotal
      WB.Close
   Next CELL
Next RowCount

End Sub








- Show quoted text -

Thanks alot mate. You are a champ.

Regards,


James