code to get column total from different sheets

Mohammednt0
4StarLounger
Posts: 456
Joined: 05 Dec 2016, 13:48

code to get column total from different sheets

Post by Mohammednt0 »

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
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
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

Post by HansV »

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

Mohammednt0
4StarLounger
Posts: 456
Joined: 05 Dec 2016, 13:48

Re: code to get column total from different sheets

Post by Mohammednt0 »

HansV wrote:
17 Aug 2021, 10:30
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
thanks for your fast reply, it worked but there is a problem , when i used it with the original excel file

- 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

User avatar
HansV
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

Post by HansV »

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

Mohammednt0
4StarLounger
Posts: 456
Joined: 05 Dec 2016, 13:48

Re: code to get column total from different sheets

Post by Mohammednt0 »

thanks, it worked , your the best.

Mohammednt0
4StarLounger
Posts: 456
Joined: 05 Dec 2016, 13:48

Re: code to get column total from different sheets

Post by Mohammednt0 »

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 :thankyou:
Last edited by Mohammednt0 on 06 Oct 2021, 12:58, edited 1 time in total.

User avatar
HansV
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

Post by HansV »

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

Mohammednt0
4StarLounger
Posts: 456
Joined: 05 Dec 2016, 13:48

Re: code to get column total from different sheets

Post by Mohammednt0 »

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 :thankyou:
Last edited by Mohammednt0 on 06 Oct 2021, 12:56, edited 1 time in total.

Mohammednt0
4StarLounger
Posts: 456
Joined: 05 Dec 2016, 13:48

Re: code to get column total from different sheets

Post by Mohammednt0 »

sorry i tried to edit the post but i was late could please take a look again sorry :scratch:

User avatar
HansV
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

Post by HansV »

Take a look at the code that I posted, and add the code for columns E and F yourself.
Best wishes,
Hans

Mohammednt0
4StarLounger
Posts: 456
Joined: 05 Dec 2016, 13:48

Re: code to get column total from different sheets

Post by Mohammednt0 »

thanks for the encouragement and support i was able to do it, you are the best. :thankyou:

User avatar
HansV
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

Post by HansV »

Great, good to hear that!
Best wishes,
Hans

Mohammednt0
4StarLounger
Posts: 456
Joined: 05 Dec 2016, 13:48

Re: code to get column total from different sheets

Post by Mohammednt0 »

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 :scratch:

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 :groan:

the original excel files are here
https://www.mediafire.com/file/zkem4mch ... k.zip/file


please help

User avatar
HansV
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

Post by HansV »

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

Mohammednt0
4StarLounger
Posts: 456
Joined: 05 Dec 2016, 13:48

Re: code to get column total from different sheets

Post by Mohammednt0 »

thanks :thankyou: