URGENT!! Need help and some advice/reference.

Z

zeecharle

New Member
Joined
Aug 26, 2015
Messages
20
Hi, Good Day!

Can anyone help me in my excel work.

I Have 1 excel file that Has multiple worksheet. The first worksheet is my master worksheet/ the summary worksheet. and the other worksheet is the worksheet that contains multiple data that are in same format/template. I want to gather all of the data from the multiple worksheet to the master/summary worksheet.

I will consider the duplicate data in different worksheet and it should add the quantity of the duplicate data.

My workbook is an inventory workbook.

Thank you for helping and your time.

-Zee
 
Sort by date Sort by votes
MARK858 said:
Be careful....untested

Rich (BB code): 
Sub zeecharle()
    Dim sht As Worksheet, LstRw As Long

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Working"

    For Each sht In ActiveWorkbook.Worksheets
        sht.Unprotect
        If sht.Name <> "Working" And sht.Name <> "SUMMARY" Then
            With sht.Range("B8:F" & sht.Range("B" & Rows.Count).End(xlUp).Row)
                Sheets("Working").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value
            End With
        End If
    Next

    With Sheets("Working")
        .Range("A1:G1") = Array("PART NAME", "SPECIFICATIONS", "MAKER", "LH", "RH", "LH2", "RH2")
        .Columns("A:F").AutoFit

    End With
    With Sheets("Working")

        LstRw = .Range("A" & Rows.Count).End(xlUp).Row

        .Range("F2").Formula = "=SUMIFS(D2:D" & LstRw & ",A2:A" & LstRw & ",A2,B2:B" & LstRw & ",B2)"
        .Range("F2").AutoFill Destination:=.Range("F2:F" & LstRw), Type:=xlFillDefault

        .Range("G2").Formula = "=SUMIFS(E2:E" & LstRw & ",A2:A" & LstRw & ",A2,B2:B" & LstRw & ",B2)"
        .Range("G2").AutoFill Destination:=.Range("G2:G" & LstRw), Type:=xlFillDefault

        .Range("H2").Formula = "=SUM(F2:G2)"
        .Range("H2").AutoFill Destination:=.Range("H2:H" & LstRw), Type:=xlFillDefault

        .Calculate
        .Range("F2:H" & LstRw).Value = .Range("F2:H" & LstRw).Value
        .Range("D2:E" & LstRw).Delete shift:=xlToLeft

        .Range("B1:B" & LstRw).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
                                              .Range("B1:B" & LstRw), Unique:=True
        .Range("A2:F" & LstRw).SpecialCells(xlCellTypeVisible).Copy
        Sheets("SUMMARY").Range("B3").PasteSpecial Paste:=xlPasteValues

        With Application
            .CutCopyMode = False
            .DisplayAlerts = False
        End With

        .Delete

    End With

    With Sheets("SUMMARY")
        .Range("B3:G" & LstRw).Sort Key1:=.Range("D3"), Order1:=xlDescending, _
                                    Key2:=.Range("C3"), Order2:=xlAscending, Header:=xlNo

    End With
    With Application
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
        .Goto Sheets("SUMMARY").Cells(1, 1), scroll:=True
        .ScreenUpdating = True
    End With



    For Each sht In ActiveWorkbook.Worksheets
        sht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Next


End Sub
Click to expand...


Hey there brother,

Thank you for the code. Very much appreciated. It already working with the sorting code.

BIG BIG BIG Help brother.

Until next time.

-ZEE
 
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
MARK858 said:
Be careful....untested

Rich (BB code): 
Sub zeecharle()
    Dim sht As Worksheet, LstRw As Long

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Working"

    For Each sht In ActiveWorkbook.Worksheets
        sht.Unprotect
        If sht.Name <> "Working" And sht.Name <> "SUMMARY" Then
            With sht.Range("B8:F" & sht.Range("B" & Rows.Count).End(xlUp).Row)
                Sheets("Working").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value
            End With
        End If
    Next

    With Sheets("Working")
        .Range("A1:G1") = Array("PART NAME", "SPECIFICATIONS", "MAKER", "LH", "RH", "LH2", "RH2")
        .Columns("A:F").AutoFit

    End With
    With Sheets("Working")

        LstRw = .Range("A" & Rows.Count).End(xlUp).Row

        .Range("F2").Formula = "=SUMIFS(D2:D" & LstRw & ",A2:A" & LstRw & ",A2,B2:B" & LstRw & ",B2)"
        .Range("F2").AutoFill Destination:=.Range("F2:F" & LstRw), Type:=xlFillDefault

        .Range("G2").Formula = "=SUMIFS(E2:E" & LstRw & ",A2:A" & LstRw & ",A2,B2:B" & LstRw & ",B2)"
        .Range("G2").AutoFill Destination:=.Range("G2:G" & LstRw), Type:=xlFillDefault

        .Range("H2").Formula = "=SUM(F2:G2)"
        .Range("H2").AutoFill Destination:=.Range("H2:H" & LstRw), Type:=xlFillDefault

        .Calculate
        .Range("F2:H" & LstRw).Value = .Range("F2:H" & LstRw).Value
        .Range("D2:E" & LstRw).Delete shift:=xlToLeft

        .Range("B1:B" & LstRw).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
                                              .Range("B1:B" & LstRw), Unique:=True
        .Range("A2:F" & LstRw).SpecialCells(xlCellTypeVisible).Copy
        Sheets("SUMMARY").Range("B3").PasteSpecial Paste:=xlPasteValues

        With Application
            .CutCopyMode = False
            .DisplayAlerts = False
        End With

        .Delete

    End With

    With Sheets("SUMMARY")
        .Range("B3:G" & LstRw).Sort Key1:=.Range("D3"), Order1:=xlDescending, _
                                    Key2:=.Range("C3"), Order2:=xlAscending, Header:=xlNo

    End With
    With Application
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
        .Goto Sheets("SUMMARY").Cells(1, 1), scroll:=True
        .ScreenUpdating = True
    End With



    For Each sht In ActiveWorkbook.Worksheets
        sht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Next


End Sub
Click to expand...


Hey Borther,

Good Day!

I've been thinking about adding another macro that copy the "SUMMARY" sheet into New workbook/excel file that doesn't contain any codes/formula only the "SUMMARY" sheet data and template. It is possible?

And one last macro on combining several excel files that has the "SUMMARY" sheet but 1 summary sheet different columns, please see the attached file for reference. It is possible in that way?

For GENERAL SUMMARY(EXPECTED)

Thank you very much!


-Zee
 
Upvote 0
MARK858


Brother, my template is a password protected. So if I run the macro it will ask the user to input the password to unprotect all the sheets. Because the macro code line goes

For Each sht In ActiveWorkbook.Worksheets
sht.Unprotect
If sht.Name <> "Working" And sht.Name <> "SUMMARY" Then
With sht.Range("B8:F" & sht.Range("B" & Rows.Count).End(xlUp).Row)
Sheets("Working").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End If
Next

How I will maintain my password protected sheet? Can that be possible?

Thank you!

-Zee
 
Upvote 0
Code: 
For Each sht In ActiveWorkbook.Worksheets
 sht.Unprotect
If sht.Name <> "Working" And sht.Name <> "SUMMARY" Then
With sht.Range("B8:F" & sht.Range("B" & Rows.Count).End(xlUp).Row)
 Sheets("Working").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End If
[COLOR="#FF0000"]sht.Protect[/COLOR]
Next
 
Upvote 0
MARK858 said:
Code: 
For Each sht In ActiveWorkbook.Worksheets
 sht.Unprotect
If sht.Name <> "Working" And sht.Name <> "SUMMARY" Then
With sht.Range("B8:F" & sht.Range("B" & Rows.Count).End(xlUp).Row)
 Sheets("Working").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End If
[COLOR=#FF0000]sht.Protect[/COLOR]
Next
Click to expand...


Hey Brother,

At the end before the "End Sub" I have this code:

Rich (BB code): 
For Each sht In ActiveWorkbook.Worksheets
        sht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Next

but the problem is the protected sheet is password protected. so the code "sht.Unprotect" trigger the password verification.

How to do?

Thank you!

And one more thing brother, did you read my other concern and questions?

Thank you very much.


-Zee
 
Upvote 0
Change MyPassword to your password


Code: 
sht.Unprotect Password:="MyPassword"

Rest of your code


sht.Protect Password:="MyPassword", DrawingObjects:=True, Contents:=True, Scenarios:=True

and you don't need a separate loop put the protect password code where indicated in my previous post


And one more thing brother, did you read my other concern and questions?
Click to expand...

A) no, haven't had time
B) it's a different question and so should be in a new thread
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
Guidance Needed: Efficient Data Collection and Liquid Stock Tracking in Excel
Replies
0
Views
91
Azzam
A
G
  • Question
Links to cells in other Workbooks occasionally change the WORKSHEET reference. Why?
2
Replies
11
Views
837
GTS
G
T
  • Question
Automatically Copying Data To A New Workbook When Closing A Workbook
Replies
4
Views
297
Tmini
T
K
  • Question
vba copying unique values of a range to another workbook.
Replies
1
Views
617
k_bs
K
Dan Wilson
  • Solved
Help with the Random Function
Replies
7
Views
450
Fluff
Fluff

Forum statistics

Threads
1,221,310
Messages
6,159,176
Members
451,543
Latest member
cesymcox

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top