code to get column total from different sheets
-
- 4StarLounger
- Posts: 456
- Joined: 05 Dec 2016, 13:48
code to get column total from different sheets
Greetings,
i need help to code this
- Go to "sheet" "1"
- Find column "OUT"
- and get the column total
- open new sheet paste the column total in Column B along with sheet name (1) in column A
- re do the same process for sheet "2" , "3" , "4" , "35" , "90" ... to the end of the sheets.
- if any sheet is missing it should ignore and go to the next sheet
e.g. sheet named "2" does not exist ignore and go to sheet "3"
so, the end result i will get a file with 2 columns.
Sheet Name (Column A)
Out (Column B)
check the attached file
thanks in advance
i need help to code this
- Go to "sheet" "1"
- Find column "OUT"
- and get the column total
- open new sheet paste the column total in Column B along with sheet name (1) in column A
- re do the same process for sheet "2" , "3" , "4" , "35" , "90" ... to the end of the sheets.
- if any sheet is missing it should ignore and go to the next sheet
e.g. sheet named "2" does not exist ignore and go to sheet "3"
so, the end result i will get a file with 2 columns.
Sheet Name (Column A)
Out (Column B)
check the attached file
thanks in advance
You do not have the required permissions to view the files attached to this post.
-
- Administrator
- Posts: 79695
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: code to get column total from different sheets
Here you go:
Code: Select all
Sub CopyTotals()
Dim wss As Worksheet
Dim wst As Worksheet
Dim s As Long
Dim c As Long
Dim t As Long
Application.ScreenUpdating = False
Set wst = Worksheets.Add(Before:=Worksheets("1"))
wst.Range("A1:B1").Value = Array("Sheet Name", "Out")
t = 1
For Each wss In Worksheets
If IsNumeric(wss.Name) Then
c = wss.Range("8:8").Find(What:="Out", LookAt:=xlWhole).Column
s = wss.Cells(wss.Rows.Count, c).End(xlUp).Row
t = t + 1
wst.Cells(t, 1).Value = wss.Name
wst.Cells(t, 2).Value = wss.Cells(s, c).Value
End If
Next wss
wst.Range("A1:B1").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 456
- Joined: 05 Dec 2016, 13:48
Re: code to get column total from different sheets
thanks for your fast reply, it worked but there is a problem , when i used it with the original excel fileHansV wrote: ↑17 Aug 2021, 10:30Here you go:
Code: Select all
Sub CopyTotals() Dim wss As Worksheet Dim wst As Worksheet Dim s As Long Dim c As Long Dim t As Long Application.ScreenUpdating = False Set wst = Worksheets.Add(Before:=Worksheets("1")) wst.Range("A1:B1").Value = Array("Sheet Name", "Out") t = 1 For Each wss In Worksheets If IsNumeric(wss.Name) Then c = wss.Range("8:8").Find(What:="Out", LookAt:=xlWhole).Column s = wss.Cells(wss.Rows.Count, c).End(xlUp).Row t = t + 1 wst.Cells(t, 1).Value = wss.Name wst.Cells(t, 2).Value = wss.Cells(s, c).Value End If Next wss wst.Range("A1:B1").EntireColumn.AutoFit Application.ScreenUpdating = True End Sub
- the code does not calculate the total thus if there is no total at the end of the column it will return empty, is it possible to make the code calculate the whole column then paste the total?
- the code should output the result to a new workbook , is it possible ?
- whenever i run the code i get error that says "run time error 91: object variable or with block variable not set"
then stops working at sheet 141 out of 200 ! please help
here is the original file its a little big thus i can not attach it, so i uploaded it to mediafire
https://www.mediafire.com/file/m9md2e0i ... .xlsx/file
-
- Administrator
- Posts: 79695
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: code to get column total from different sheets
What's the point of having completely empty sheets?
Code: Select all
Sub CopyTotals()
Dim wbs As Workbook
Dim wss As Worksheet
Dim wbt As Workbook
Dim wst As Worksheet
Dim rng As Range
Dim s As Long
Dim c As Long
Dim t As Long
Application.ScreenUpdating = False
Set wbs = ActiveWorkbook ' or ThisWorkbook
Set wbt = Workbooks.Add(Template:=xlWBATWorksheet)
Set wst = wbt.Worksheets(1)
wst.Range("A1:B1").Value = Array("Sheet Name", "Out")
t = 1
For Each wss In wbs.Worksheets
If IsNumeric(wss.Name) Then
Set rng = wss.Range("8:8").Find(What:="Out", LookAt:=xlWhole)
If Not rng Is Nothing Then
c = rng.Column
s = wss.Cells(wss.Rows.Count, c).End(xlUp).Row
t = t + 1
wst.Cells(t, 1).Value = wss.Name
If wss.Cells(s, c).Value <> "" Then
wst.Cells(t, 2).Value = wss.Cells(s, c).Value
Else
wst.Cells(t, 2).Value = Application.Sum(wss.Range(wss.Cells(9, c), wss.Cells(s, c)))
End If
End If
End If
Next wss
wst.Range("A1:B1").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 456
- Joined: 05 Dec 2016, 13:48
Re: code to get column total from different sheets
thanks, it worked , your the best.
-
- 4StarLounger
- Posts: 456
- Joined: 05 Dec 2016, 13:48
Re: code to get column total from different sheets
is it possible to edit the code to add 2 more columns and make it work with multiple workbooks?
so, the end result i will be like.
workbook name (column A)
item ( column B)
Sheet Name (Column A before now, it should be column C)
Out (Column B before, now it should be column D)
workbook name (column A):
it will copy the name of the workbook then paste it in column A and it will repeat the process till the end of the workbook, then the code will go to the next workbook in the path (path: C:\Bayad) and start getting the workbook name , item , sheet name , and out columns, and repeat till the end of the workbooks
item ( column B):
it will just copy cell "B4" after copying out
so what the code do is like this:
- go to path: C:\Bayad and start with the first workbook
- get workbook name and paste it in column A, then open the workbook
- Go to "sheet" "1"
- Find column "OUT"
- and get the column total
- open new workbook paste the column total in Column D along with sheet name (1) in column C
- copy cell "B4" paste it in column B
- re do the same process for sheet "2" , "3" , "4" , "35" , "90" ... to the end of the sheets.
- go to path: C:\Bayad and start with the second workbook and repeat the whole process till the end of the workbooks
Workbooks can be found here: https://www.mediafire.com/file/juo79pbu ... ad.7z/file
i really appreciate this forum it helped me a lot, many thanks for the support and help
so, the end result i will be like.
workbook name (column A)
item ( column B)
Sheet Name (Column A before now, it should be column C)
Out (Column B before, now it should be column D)
workbook name (column A):
it will copy the name of the workbook then paste it in column A and it will repeat the process till the end of the workbook, then the code will go to the next workbook in the path (path: C:\Bayad) and start getting the workbook name , item , sheet name , and out columns, and repeat till the end of the workbooks
item ( column B):
it will just copy cell "B4" after copying out
so what the code do is like this:
- go to path: C:\Bayad and start with the first workbook
- get workbook name and paste it in column A, then open the workbook
- Go to "sheet" "1"
- Find column "OUT"
- and get the column total
- open new workbook paste the column total in Column D along with sheet name (1) in column C
- copy cell "B4" paste it in column B
- re do the same process for sheet "2" , "3" , "4" , "35" , "90" ... to the end of the sheets.
- go to path: C:\Bayad and start with the second workbook and repeat the whole process till the end of the workbooks
Workbooks can be found here: https://www.mediafire.com/file/juo79pbu ... ad.7z/file
i really appreciate this forum it helped me a lot, many thanks for the support and help
Last edited by Mohammednt0 on 06 Oct 2021, 12:58, edited 1 time in total.
-
- Administrator
- Posts: 79695
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: code to get column total from different sheets
Try this version:
Code: Select all
Sub CopyTotals()
Dim fso As Object
Dim fld As Object
Dim fil As Object
Dim wbs As Workbook
Dim wss As Worksheet
Dim wbt As Workbook
Dim wst As Worksheet
Dim rng As Range
Dim s As Long
Dim c As Long
Dim t As Long
Application.ScreenUpdating = False
Set wbt = Workbooks.Add(Template:=xlWBATWorksheet)
Set wst = wbt.Worksheets(1)
wst.Range("A1:D1").Value = Array("Workbook Name", "Item", "Sheet Name", "Out")
t = 1
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder("C:\Users\javog\Documents\Excel\Bayad")
For Each fil In fld.Files
If LCase(fso.GetExtensionName(fil)) = "xlsx" Then
Set wbs = Workbooks.Open(fil)
For Each wss In wbs.Worksheets
If IsNumeric(wss.Name) Then
Set rng = wss.Range("8:8").Find(What:="Out", LookAt:=xlWhole)
If Not rng Is Nothing Then
c = rng.Column
s = wss.Cells(wss.Rows.Count, c).End(xlUp).Row
t = t + 1
wst.Cells(t, 1).Value = wbs.Name
wst.Cells(t, 2).Value = wss.Range("B4").Value
wst.Cells(t, 3).Value = wss.Name
If wss.Cells(s, c).Value <> "" Then
wst.Cells(t, 4).Value = wss.Cells(s, c).Value
Else
wst.Cells(t, 4).Value = Application.Sum(wss.Range(wss.Cells(9, c), wss.Cells(s, c)))
End If
End If
End If
Next wss
wbs.Close SaveChanges:=False
End If
Next fil
wst.Range("A1:D1").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 456
- Joined: 05 Dec 2016, 13:48
Re: code to get column total from different sheets
is it possible to edit the code to add more columns and make it work with multiple workbooks?
so, the end result i will get a file with 6 columns:
Column A (workbook name)
Column B (item)
Column C (Sheet Name) it was Column A before, now it should be column C
Column D (In)
Column E (Out) it was Column A before, now it should be column D
Column F (Balance)
New columns:
Column A (workbook name):
it will copy the name of the workbook then paste it in column A and it will repeat the process till the end of the workbook, then the code will go to the next workbook in the path (path: C:\Bayad) and start getting the workbook name , item , sheet name , and out columns, and repeat till the end of the workbooks
Column B (item):
it will just copy cell "B4" after copying out
Column D (In)
Find column "In", and get the column total
Column F (Balance)
Column D – Column E= Balance
so what the code will do is like this:
1. go to path: C:\Bayad and start with the first workbook
2. get workbook name and paste it in column A, then open the workbook
3. Go to "sheet" "1"
4. Find column "OUT" and get the column total
open new workbook and paste the column total in Column E along with sheet name (1) in column C
5. Find column "IN", and get the column total
Go to workbook and paste the column total in Column E along with sheet name (1) in column C
6. copy cell "B4" paste it in column B
7. Now Column D – Column E= Balance
8. re do the same process for sheet "2" , "3" , "4" , "35" , "90" ... to the end of the sheets.
9. go to path: C:\Bayad and start with the second workbook and repeat the whole process till the end of the workbooks
Workbooks can be found here: https://www.mediafire.com/file/juo79pbu ... ad.7z/file
i really appreciate this forum it helped me a lot, many thanks for the support and help
so, the end result i will get a file with 6 columns:
Column A (workbook name)
Column B (item)
Column C (Sheet Name) it was Column A before, now it should be column C
Column D (In)
Column E (Out) it was Column A before, now it should be column D
Column F (Balance)
New columns:
Column A (workbook name):
it will copy the name of the workbook then paste it in column A and it will repeat the process till the end of the workbook, then the code will go to the next workbook in the path (path: C:\Bayad) and start getting the workbook name , item , sheet name , and out columns, and repeat till the end of the workbooks
Column B (item):
it will just copy cell "B4" after copying out
Column D (In)
Find column "In", and get the column total
Column F (Balance)
Column D – Column E= Balance
so what the code will do is like this:
1. go to path: C:\Bayad and start with the first workbook
2. get workbook name and paste it in column A, then open the workbook
3. Go to "sheet" "1"
4. Find column "OUT" and get the column total
open new workbook and paste the column total in Column E along with sheet name (1) in column C
5. Find column "IN", and get the column total
Go to workbook and paste the column total in Column E along with sheet name (1) in column C
6. copy cell "B4" paste it in column B
7. Now Column D – Column E= Balance
8. re do the same process for sheet "2" , "3" , "4" , "35" , "90" ... to the end of the sheets.
9. go to path: C:\Bayad and start with the second workbook and repeat the whole process till the end of the workbooks
Workbooks can be found here: https://www.mediafire.com/file/juo79pbu ... ad.7z/file
i really appreciate this forum it helped me a lot, many thanks for the support and help
Last edited by Mohammednt0 on 06 Oct 2021, 12:56, edited 1 time in total.
-
- 4StarLounger
- Posts: 456
- Joined: 05 Dec 2016, 13:48
Re: code to get column total from different sheets
sorry i tried to edit the post but i was late could please take a look again sorry
-
- Administrator
- Posts: 79695
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: code to get column total from different sheets
Take a look at the code that I posted, and add the code for columns E and F yourself.
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 456
- Joined: 05 Dec 2016, 13:48
Re: code to get column total from different sheets
thanks for the encouragement and support i was able to do it, you are the best.
-
- Administrator
- Posts: 79695
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
-
- 4StarLounger
- Posts: 456
- Joined: 05 Dec 2016, 13:48
Re: code to get column total from different sheets
sorry for opening this topic again, i need help
i have 2 problems in the code i wasn't able to solve them, please help me
the first one:
the structure of the sheet changed a little so i have to keep deleting column "C" (Code) , run the below 2 codes, then add column "C" (Code) again every time i want to run the codes
the second one:
i want the above 2 codes (CopyTotals1 & CopyTotals2) to become one code
the original excel files are here
https://www.mediafire.com/file/zkem4mch ... k.zip/file
please help
i have 2 problems in the code i wasn't able to solve them, please help me
the first one:
the structure of the sheet changed a little so i have to keep deleting column "C" (Code) , run the below 2 codes, then add column "C" (Code) again every time i want to run the codes
Code: Select all
Sub CopyTotals1()
Dim fso As Object
Dim fld As Object
Dim fil As Object
Dim wbs As Workbook
Dim wss As Worksheet
Dim wst As Worksheet
Dim rng As Range
Dim s As Long
Dim c As Long
Dim t As Long
Application.ScreenUpdating = False
Set wst = Worksheets(1)
wst.Range("A1:E1").Value = Array("Workbook Name", "Item", "Item No.", "In", "Out")
t = 1
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder("C:\Users\iya\Desktop\Inventory Analysis Reports\Data\Al Bayad Reports\Bayad")
For Each fil In fld.Files
If LCase(fso.GetExtensionName(fil)) = "xlsx" Then
Set wbs = Workbooks.Open(fil)
For Each wss In wbs.Worksheets
If IsNumeric(wss.Name) Then
Set rng = wss.Range("8:8").Find(What:="Out", LookAt:=xlWhole)
If Not rng Is Nothing Then
c = rng.Column
s = wss.Cells(wss.Rows.Count, c).End(xlUp).Row
t = t + 1
wst.Cells(t, 1).Value = wbs.Name
wst.Cells(t, 2).Value = wss.Range("B4").Value
wst.Cells(t, 3).Value = wss.Name
If wss.Cells(s, c).Value <> "" Then
wst.Cells(t, 5).Value = wss.Cells(s, c).Value
Else
wst.Cells(t, 5).Value = Application.Sum(wss.Range(wss.Cells(9, c), wss.Cells(s, c)))
End If
End If
End If
Next wss
wbs.Close SaveChanges:=False
End If
Next fil
wst.Range("A1:E1").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Code: Select all
Sub CopyTotals2()
Dim fso As Object
Dim fld As Object
Dim fil As Object
Dim wbs As Workbook
Dim wss As Worksheet
Dim wst As Worksheet
Dim rng As Range
Dim s As Long
Dim c As Long
Dim t As Long
Application.ScreenUpdating = False
Set wst = Worksheets(1)
wst.Range("A1:E1").Value = Array("Workbook Name", "Item", "Item No.", "In", "Out")
t = 1
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder("C:\Users\iya\Desktop\Inventory Analysis Reports\Data\Al Bayad Reports\Bayad")
For Each fil In fld.Files
If LCase(fso.GetExtensionName(fil)) = "xlsx" Then
Set wbs = Workbooks.Open(fil)
For Each wss In wbs.Worksheets
If IsNumeric(wss.Name) Then
Set rng = wss.Range("8:8").Find(What:="In", LookAt:=xlWhole)
If Not rng Is Nothing Then
c = rng.Column
s = wss.Cells(wss.Rows.Count, c).End(xlUp).Row
t = t + 1
wst.Cells(t, 1).Value = wbs.Name
wst.Cells(t, 2).Value = wss.Range("B4").Value
wst.Cells(t, 3).Value = wss.Name
If wss.Cells(s, c).Value <> "" Then
wst.Cells(t, 4).Value = wss.Cells(s, c).Value
Else
wst.Cells(t, 4).Value = Application.Sum(wss.Range(wss.Cells(9, c), wss.Cells(s, c)))
End If
End If
End If
Next wss
wbs.Close SaveChanges:=False
End If
Next fil
wst.Range("A1:E1").EntireColumn.AutoFit
Application.ScreenUpdating = True
Columns("C:C").Select
Selection.Cut
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
End Sub
the second one:
i want the above 2 codes (CopyTotals1 & CopyTotals2) to become one code
the original excel files are here
https://www.mediafire.com/file/zkem4mch ... k.zip/file
please help
-
- Administrator
- Posts: 79695
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: code to get column total from different sheets
Does this do what you want?
Code: Select all
Sub CopyTotals()
Dim fso As Object
Dim fld As Object
Dim fil As Object
Dim wbs As Workbook
Dim wss As Worksheet
Dim wst As Worksheet
Dim rng As Range
Dim s As Long
Dim c As Long
Dim t As Long
Application.ScreenUpdating = False
Set wst = Worksheets(1)
wst.Range("A1:E1").Value = Array("Workbook Name", "Item", "Item No.", "In", "Out")
t = 1
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder("C:\Users\iya\Desktop\Inventory Analysis Reports\Data\Al Bayad Reports\Bayad")
For Each fil In fld.Files
If LCase(fso.GetExtensionName(fil)) = "xlsx" Then
Set wbs = Workbooks.Open(fil)
For Each wss In wbs.Worksheets
If IsNumeric(wss.Name) Then
Set rng = wss.Range("8:8").Find(What:="Out", LookAt:=xlWhole)
If Not rng Is Nothing Then
c = rng.Column
s = wss.Cells(wss.Rows.Count, c).End(xlUp).Row
t = t + 1
wst.Cells(t, 1).Value = wbs.Name
wst.Cells(t, 2).Value = wss.Range("B4").Value
wst.Cells(t, 3).Value = wss.Name
If wss.Cells(s, c).Value <> "" Then
wst.Cells(t, 5).Value = wss.Cells(s, c).Value
Else
wst.Cells(t, 5).Value = Application.Sum(wss.Range(wss.Cells(9, c), wss.Cells(s, c)))
End If
End If
Set rng = wss.Range("8:8").Find(What:="In", LookAt:=xlWhole)
If Not rng Is Nothing Then
c = rng.Column
s = wss.Cells(wss.Rows.Count, c).End(xlUp).Row
t = t + 1
wst.Cells(t, 1).Value = wbs.Name
wst.Cells(t, 2).Value = wss.Range("B4").Value
wst.Cells(t, 3).Value = wss.Name
If wss.Cells(s, c).Value <> "" Then
wst.Cells(t, 4).Value = wss.Cells(s, c).Value
Else
wst.Cells(t, 4).Value = Application.Sum(wss.Range(wss.Cells(9, c), wss.Cells(s, c)))
End If
End If
End If
Next wss
wbs.Close SaveChanges:=False
End If
Next fil
wst.Range("A1:E1").EntireColumn.AutoFit
Application.ScreenUpdating = True
Columns("C:C").Cut
Columns("B:B").Insert Shift:=xlToRight
Application.ScreenUpdating = True
End Sub
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 456
- Joined: 05 Dec 2016, 13:48