Summing
 

The code looks through files ina folder and then dumps the figures in a
worksheet,
then at bottom sums cells, the looping & dumping works fine,
doesn't seem to sum, help is much appreciated, thanks

Sub SubGetMyData3c()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim owb As Workbook
Dim j, k As Long
Dim RngToCopy, Rng2ToCopy As Range
Dim intNumRows As Integer, c As Variant, lngCellTotal As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\My Documents\Career")

j = 1
k = 1
l = 1
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Set owb = Workbooks.Open(Filename:=objFolder.Path _
& "\" & objFile.Name)
With owb.Worksheets("Proposals")
Set RngToCopy = .Range("b1:B" _
& .Cells(.Rows.Count, "B").End(xlUp).Row)
End With

RngToCopy.EntireRow.Copy _
Destination:=Worksheets("Proposals05").Cells(j, 1)

j = Worksheets("Proposals05") _
.Cells(Rows.Count, "A").End(xlUp).Row + 1




intNumRows = Cells(50, "b").End(xlUp).Row
With Range("b" & intNumRows + 1)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium

End With
For Each c In Range("b1", "b" & intNumRows)
lngCellTotal = lngCellTotal + c.Value
Next
Range("b" & intNumRows + 1) = lngCellTotal
End If
Next objFile
End Sub

Summing
 

Sub SubGetMyData3c()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim owb As Workbook
Dim j As Long
Dim RngToCopy, Rng2ToCopy As Range
Dim intNumRows As Integer, c As Range, lngCellTotal As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\My Documents\Career")

j = 1: k = 1: l = 1
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Set owb = Workbooks.Open(Filename:=objFolder.Path _
& "\" & objFile.Name)
With owb.Worksheets("Proposals")
Set RngToCopy = .Range("B1:B" _
& .Cells(.Rows.Count, "B").End(xlUp).Row)
End With

RngToCopy.EntireRow.Copy _
Destination:=Worksheets("Proposals05").Cells(j, 1)

j = Worksheets("Proposals05") _
.Cells(Rows.Count, "A").End(xlUp).Row + 1

intNumRows = Cells(50, "B").End(xlUp).Row
End If
Next objFile

For Each c In Worksheets("Proposals05").Range("B1:B" & intNumRows)
lngCellTotal = lngCellTotal + c.Value
Next

With Worksheets("Proposals05").Range("B" & intNumRows + 1)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Value = lngCellTotal
End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)


"teresa" wrote in message
...
The code looks through files ina folder and then dumps the figures in a
worksheet,
then at bottom sums cells, the looping & dumping works fine,
doesn't seem to sum, help is much appreciated, thanks

Sub SubGetMyData3c()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim owb As Workbook
Dim j, k As Long
Dim RngToCopy, Rng2ToCopy As Range
Dim intNumRows As Integer, c As Variant, lngCellTotal As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\My Documents\Career")

j = 1
k = 1
l = 1
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Set owb = Workbooks.Open(Filename:=objFolder.Path _
& "\" & objFile.Name)
With owb.Worksheets("Proposals")
Set RngToCopy = .Range("b1:B" _
& .Cells(.Rows.Count, "B").End(xlUp).Row)
End With

RngToCopy.EntireRow.Copy _
Destination:=Worksheets("Proposals05").Cells(j, 1)

j = Worksheets("Proposals05") _
.Cells(Rows.Count, "A").End(xlUp).Row + 1




intNumRows = Cells(50, "b").End(xlUp).Row
With Range("b" & intNumRows + 1)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium

End With
For Each c In Range("b1", "b" & intNumRows)
lngCellTotal = lngCellTotal + c.Value
Next
Range("b" & intNumRows + 1) = lngCellTotal
End If
Next objFile
End Sub

Summing
 

Thanks A million Bob


"Bob Phillips" wrote:

Sub SubGetMyData3c()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim owb As Workbook
Dim j As Long
Dim RngToCopy, Rng2ToCopy As Range
Dim intNumRows As Integer, c As Range, lngCellTotal As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\My Documents\Career")

j = 1: k = 1: l = 1
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Set owb = Workbooks.Open(Filename:=objFolder.Path _
& "\" & objFile.Name)
With owb.Worksheets("Proposals")
Set RngToCopy = .Range("B1:B" _
& .Cells(.Rows.Count, "B").End(xlUp).Row)
End With

RngToCopy.EntireRow.Copy _
Destination:=Worksheets("Proposals05").Cells(j, 1)

j = Worksheets("Proposals05") _
.Cells(Rows.Count, "A").End(xlUp).Row + 1

intNumRows = Cells(50, "B").End(xlUp).Row
End If
Next objFile

For Each c In Worksheets("Proposals05").Range("B1:B" & intNumRows)
lngCellTotal = lngCellTotal + c.Value
Next

With Worksheets("Proposals05").Range("B" & intNumRows + 1)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Value = lngCellTotal
End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)


"teresa" wrote in message
...
The code looks through files ina folder and then dumps the figures in a
worksheet,
then at bottom sums cells, the looping & dumping works fine,
doesn't seem to sum, help is much appreciated, thanks

Sub SubGetMyData3c()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim owb As Workbook
Dim j, k As Long
Dim RngToCopy, Rng2ToCopy As Range
Dim intNumRows As Integer, c As Variant, lngCellTotal As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\My Documents\Career")

j = 1
k = 1
l = 1
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Set owb = Workbooks.Open(Filename:=objFolder.Path _
& "\" & objFile.Name)
With owb.Worksheets("Proposals")
Set RngToCopy = .Range("b1:B" _
& .Cells(.Rows.Count, "B").End(xlUp).Row)
End With

RngToCopy.EntireRow.Copy _
Destination:=Worksheets("Proposals05").Cells(j, 1)

j = Worksheets("Proposals05") _
.Cells(Rows.Count, "A").End(xlUp).Row + 1




intNumRows = Cells(50, "b").End(xlUp).Row
With Range("b" & intNumRows + 1)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium

End With
For Each c In Range("b1", "b" & intNumRows)
lngCellTotal = lngCellTotal + c.Value
Next
Range("b" & intNumRows + 1) = lngCellTotal
End If
Next objFile
End Sub

Summing
 

Is it all working now? It's been a long journey :-)

Bob

"teresa" wrote in message
...
Thanks A million Bob


"Bob Phillips" wrote:

Sub SubGetMyData3c()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim owb As Workbook
Dim j As Long
Dim RngToCopy, Rng2ToCopy As Range
Dim intNumRows As Integer, c As Range, lngCellTotal As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\My Documents\Career")

j = 1: k = 1: l = 1
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Set owb = Workbooks.Open(Filename:=objFolder.Path _
& "\" & objFile.Name)
With owb.Worksheets("Proposals")
Set RngToCopy = .Range("B1:B" _
& .Cells(.Rows.Count,
"B").End(xlUp).Row)
End With

RngToCopy.EntireRow.Copy _
Destination:=Worksheets("Proposals05").Cells(j, 1)

j = Worksheets("Proposals05") _
.Cells(Rows.Count, "A").End(xlUp).Row + 1

intNumRows = Cells(50, "B").End(xlUp).Row
End If
Next objFile

For Each c In Worksheets("Proposals05").Range("B1:B" & intNumRows)
lngCellTotal = lngCellTotal + c.Value
Next

With Worksheets("Proposals05").Range("B" & intNumRows + 1)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Value = lngCellTotal
End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)


"teresa" wrote in message
...
The code looks through files ina folder and then dumps the figures in
a
worksheet,
then at bottom sums cells, the looping & dumping works fine,
doesn't seem to sum, help is much appreciated, thanks

Sub SubGetMyData3c()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim owb As Workbook
Dim j, k As Long
Dim RngToCopy, Rng2ToCopy As Range
Dim intNumRows As Integer, c As Variant, lngCellTotal As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\My Documents\Career")

j = 1
k = 1
l = 1
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Set owb = Workbooks.Open(Filename:=objFolder.Path _
& "\" & objFile.Name)
With owb.Worksheets("Proposals")
Set RngToCopy = .Range("b1:B" _
& .Cells(.Rows.Count,
"B").End(xlUp).Row)
End With

RngToCopy.EntireRow.Copy _
Destination:=Worksheets("Proposals05").Cells(j, 1)

j = Worksheets("Proposals05") _
.Cells(Rows.Count, "A").End(xlUp).Row + 1




intNumRows = Cells(50, "b").End(xlUp).Row
With Range("b" & intNumRows + 1)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium

End With
For Each c In Range("b1", "b" & intNumRows)
lngCellTotal = lngCellTotal + c.Value
Next
Range("b" & intNumRows + 1) = lngCellTotal
End If
Next objFile
End Sub

Summing
 

Bob, not quite - but we're getting there :-)

"Bob Phillips" wrote:

Is it all working now? It's been a long journey :-)

Bob

"teresa" wrote in message
...
Thanks A million Bob


"Bob Phillips" wrote:

Sub SubGetMyData3c()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim owb As Workbook
Dim j As Long
Dim RngToCopy, Rng2ToCopy As Range
Dim intNumRows As Integer, c As Range, lngCellTotal As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\My Documents\Career")

j = 1: k = 1: l = 1
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Set owb = Workbooks.Open(Filename:=objFolder.Path _
& "\" & objFile.Name)
With owb.Worksheets("Proposals")
Set RngToCopy = .Range("B1:B" _
& .Cells(.Rows.Count,
"B").End(xlUp).Row)
End With

RngToCopy.EntireRow.Copy _
Destination:=Worksheets("Proposals05").Cells(j, 1)

j = Worksheets("Proposals05") _
.Cells(Rows.Count, "A").End(xlUp).Row + 1

intNumRows = Cells(50, "B").End(xlUp).Row
End If
Next objFile

For Each c In Worksheets("Proposals05").Range("B1:B" & intNumRows)
lngCellTotal = lngCellTotal + c.Value
Next

With Worksheets("Proposals05").Range("B" & intNumRows + 1)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Value = lngCellTotal
End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)


"teresa" wrote in message
...
The code looks through files ina folder and then dumps the figures in
a
worksheet,
then at bottom sums cells, the looping & dumping works fine,
doesn't seem to sum, help is much appreciated, thanks

Sub SubGetMyData3c()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim owb As Workbook
Dim j, k As Long
Dim RngToCopy, Rng2ToCopy As Range
Dim intNumRows As Integer, c As Variant, lngCellTotal As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\My Documents\Career")

j = 1
k = 1
l = 1
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Set owb = Workbooks.Open(Filename:=objFolder.Path _
& "\" & objFile.Name)
With owb.Worksheets("Proposals")
Set RngToCopy = .Range("b1:B" _
& .Cells(.Rows.Count,
"B").End(xlUp).Row)
End With

RngToCopy.EntireRow.Copy _
Destination:=Worksheets("Proposals05").Cells(j, 1)

j = Worksheets("Proposals05") _
.Cells(Rows.Count, "A").End(xlUp).Row + 1




intNumRows = Cells(50, "b").End(xlUp).Row
With Range("b" & intNumRows + 1)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium

End With
For Each c In Range("b1", "b" & intNumRows)
lngCellTotal = lngCellTotal + c.Value
Next
Range("b" & intNumRows + 1) = lngCellTotal
End If
Next objFile
End Sub