Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 169
Default Looping & 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

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,337
Default Looping & Summing

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


this idea may be easier & quicker. Modify to suit your needs
range("b5")=Application.Sum(Range("b1:b4"))


--
Don Guillett
SalesAid Software

"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



  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,272
Default Looping & Summing

See response to other post.

--

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



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Looping Maggie[_6_] Excel Discussion (Misc queries) 6 October 2nd 08 09:14 PM
Not Looping Roger Excel Discussion (Misc queries) 0 February 26th 08 05:18 PM
PivotTable and summing/not summing ~*Amanda*~[_2_] Excel Discussion (Misc queries) 1 March 14th 07 07:35 PM
Looping Andrew Clark[_2_] Excel Programming 1 December 20th 03 05:01 PM
Looping Syd[_4_] Excel Programming 1 December 11th 03 11:17 PM


All times are GMT +1. The time now is 07:16 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"