Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
auto add column
Hi there,
i am hoping you can help. i hav the following code (see below) which takes numbers from multiple spreadsheets etc (and it works well) however i am trying to do 1 last thing and that is as follows: The number that is placed in cell (iRow, 6) i would like to have tallied at the end of the script, so for instance if there are 70 numbers then i would like to leave a space and have a tally appear just underneath it in Cell 'f' Line 72. Is this easy to do? Thanking you in advance Scott Sub SubGetMyData() Application.ScreenUpdating = False Dim objFSO As Scripting.FileSystemObject Dim objFolder As Scripting.Folder Dim objSubfolder As Scripting.Folder Dim objFile As Scripting.File Dim iRow As Long iRow = 3 Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder("e:\scott\Sotek\Invoices\") For Each objFile In objFolder.Files If objFile.Type = "Microsoft Excel Worksheet" Then Workbooks.Open Filename:=objFolder.Path & "\" & objFile.Name With ActiveWorkbook.Worksheets(1) .Range("A13").Copy Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 1) .Range("A14").Copy Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 2) .Range("A15").Copy Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 3) .Range("F7").Copy Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 4) .Range("F8").Copy Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 5) ThisWorkbook.Worksheets(1).Cells(iRow, 6).Value = ..Range("f45").Value End With ActiveWorkbook.Close savechanges:=False iRow = iRow + 1 End If Next Application.ScreenUpdating = True End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
auto add column
How about:
Option Explicit Sub SubGetMyData() Application.ScreenUpdating = False Dim objFSO As Scripting.FileSystemObject Dim objFolder As Scripting.Folder Dim objSubfolder As Scripting.Folder Dim objFile As Scripting.File Dim iRow As Long iRow = 3 Set objFSO = CreateObject("Scripting.FileSystemObject") 'Set objFolder = objFSO.getfolder("e:\scott\Sotek\Invoices\") Set objFolder = objFSO.getfolder("C:\my documents\excel\test\") For Each objFile In objFolder.Files If objFile.Type = "Microsoft Excel Worksheet" Then Workbooks.Open Filename:=objFolder.Path & "\" & objFile.Name With ActiveWorkbook.Worksheets(1) .Range("A13").Copy _ Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 1) .Range("A14").Copy _ Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 2) .Range("A15").Copy _ Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 3) .Range("F7").Copy _ Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 4) .Range("F8").Copy _ Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 5) ThisWorkbook.Worksheets(1).Cells(iRow, 6).Value _ = .Range("f45").Value End With ActiveWorkbook.Close savechanges:=False iRow = iRow + 1 End If Next With ThisWorkbook.Worksheets(1) .Cells(iRow + 1, 6).Formula _ = "=sum(" & .Range(.Cells(3, 6), _ .Cells(iRow - 1, 6)).Address(0, 0) & ")" End With Application.ScreenUpdating = True End Sub I noticed that you changed that last copy (F45) to just an assignment. Just curious: Is there some reason you didn't adjust the others, too? ThisWorkbook.Worksheets(1).Cells(iRow, 1).value = .range("A13").value (and so forth) Scott wrote: Hi there, i am hoping you can help. i hav the following code (see below) which takes numbers from multiple spreadsheets etc (and it works well) however i am trying to do 1 last thing and that is as follows: The number that is placed in cell (iRow, 6) i would like to have tallied at the end of the script, so for instance if there are 70 numbers then i would like to leave a space and have a tally appear just underneath it in Cell 'f' Line 72. Is this easy to do? Thanking you in advance Scott Sub SubGetMyData() Application.ScreenUpdating = False Dim objFSO As Scripting.FileSystemObject Dim objFolder As Scripting.Folder Dim objSubfolder As Scripting.Folder Dim objFile As Scripting.File Dim iRow As Long iRow = 3 Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder("e:\scott\Sotek\Invoices\") For Each objFile In objFolder.Files If objFile.Type = "Microsoft Excel Worksheet" Then Workbooks.Open Filename:=objFolder.Path & "\" & objFile.Name With ActiveWorkbook.Worksheets(1) .Range("A13").Copy Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 1) .Range("A14").Copy Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 2) .Range("A15").Copy Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 3) .Range("F7").Copy Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 4) .Range("F8").Copy Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 5) ThisWorkbook.Worksheets(1).Cells(iRow, 6).Value = .Range("f45").Value End With ActiveWorkbook.Close savechanges:=False iRow = iRow + 1 End If Next Application.ScreenUpdating = True End Sub -- Dave Peterson |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
auto add column
I'd guess that you dropped this line:
With ThisWorkbook.Worksheets(1) But your formula looks fine to me. (Maybe even easier to understand!!!) "Scott" wrote in message ... Hi Dave, tried your post but i couldn't get it work as it errored here ".Cells(3, 6)" (invalid or unqualified reference), however i managed to bash it around to this ThisWorkbook.Worksheets(1).Cells(iRow + 1, 6) = "=Sum(F2:F" & (iRow - 1) & ")" It's probably not the best coded but alas it works. Thanks for your help it was greatly appreciated. Regards Scott "Dave Peterson" wrote in message ... How about: Option Explicit Sub SubGetMyData() Application.ScreenUpdating = False Dim objFSO As Scripting.FileSystemObject Dim objFolder As Scripting.Folder Dim objSubfolder As Scripting.Folder Dim objFile As Scripting.File Dim iRow As Long iRow = 3 Set objFSO = CreateObject("Scripting.FileSystemObject") 'Set objFolder = objFSO.getfolder("e:\scott\Sotek\Invoices\") Set objFolder = objFSO.getfolder("C:\my documents\excel\test\") For Each objFile In objFolder.Files If objFile.Type = "Microsoft Excel Worksheet" Then Workbooks.Open Filename:=objFolder.Path & "\" & objFile.Name With ActiveWorkbook.Worksheets(1) .Range("A13").Copy _ Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 1) .Range("A14").Copy _ Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 2) .Range("A15").Copy _ Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 3) .Range("F7").Copy _ Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 4) .Range("F8").Copy _ Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 5) ThisWorkbook.Worksheets(1).Cells(iRow, 6).Value _ = .Range("f45").Value End With ActiveWorkbook.Close savechanges:=False iRow = iRow + 1 End If Next With ThisWorkbook.Worksheets(1) .Cells(iRow + 1, 6).Formula _ = "=sum(" & .Range(.Cells(3, 6), _ .Cells(iRow - 1, 6)).Address(0, 0) & ")" End With Application.ScreenUpdating = True End Sub I noticed that you changed that last copy (F45) to just an assignment. Just curious: Is there some reason you didn't adjust the others, too? ThisWorkbook.Worksheets(1).Cells(iRow, 1).value = .range("A13").value (and so forth) Scott wrote: Hi there, i am hoping you can help. i hav the following code (see below) which takes numbers from multiple spreadsheets etc (and it works well) however i am trying to do 1 last thing and that is as follows: The number that is placed in cell (iRow, 6) i would like to have tallied at the end of the script, so for instance if there are 70 numbers then i would like to leave a space and have a tally appear just underneath it in Cell 'f' Line 72. Is this easy to do? Thanking you in advance Scott Sub SubGetMyData() Application.ScreenUpdating = False Dim objFSO As Scripting.FileSystemObject Dim objFolder As Scripting.Folder Dim objSubfolder As Scripting.Folder Dim objFile As Scripting.File Dim iRow As Long iRow = 3 Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder("e:\scott\Sotek\Invoices\") For Each objFile In objFolder.Files If objFile.Type = "Microsoft Excel Worksheet" Then Workbooks.Open Filename:=objFolder.Path & "\" & objFile.Name With ActiveWorkbook.Worksheets(1) .Range("A13").Copy Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 1) .Range("A14").Copy Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 2) .Range("A15").Copy Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 3) .Range("F7").Copy Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 4) .Range("F8").Copy Destination:=ThisWorkbook.Worksheets(1).Cells(iRow , 5) ThisWorkbook.Worksheets(1).Cells(iRow, 6).Value = .Range("f45").Value End With ActiveWorkbook.Close savechanges:=False iRow = iRow + 1 End If Next Application.ScreenUpdating = True End Sub -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Auto fit row height for one column | Excel Discussion (Misc queries) | |||
How do I add a column of numbers (auto sum)?? | Excel Worksheet Functions | |||
auto fit of column in EXCEL | Excel Discussion (Misc queries) | |||
How can I auto refresh a column that has an auto filter in place | Excel Discussion (Misc queries) | |||
Auto BOLD max value in a column | Excel Worksheet Functions |