PDA

View Full Version : Sum text after grouping



MPDK166
04-21-2011, 02:07 AM
Hi,

For Each ws In Worksheets
wsM_LR = wsMain.Cells.Find("*", , , , xlByRows, xlPrevious).Row
If UCase(ws.Name) <> UCase(wsMain.Name) And UCase(ws.Name) <> UCase(wsMain1.Name) And UCase(ws.Name) <> UCase(wsMain2.Name) And UCase(ws.Name) <> UCase(wsMain3.Name) And UCase(ws.Name) <> UCase(wsMain4.Name) And UCase(ws.Name) <> UCase(wsMain5.Name) Then
With ws
LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
.Range("C7:C" & LR).Copy Destination:=wsMain.Cells(wsM_LR + 1, "A")
.Range("B7:B" & LR).Copy Destination:=wsMain.Cells(wsM_LR + 1, "B")
.Range("E7:E" & LR).Copy Destination:=wsMain.Cells(wsM_LR + 1, "C")
.Range("G7:G" & LR).Copy Destination:=wsMain.Cells(wsM_LR + 1, "D")
.Range("F7:F" & LR).Copy Destination:=wsMain.Cells(wsM_LR + 1, "E")
End With
End If
Next ws

With wsMain
Range("A2:E65536").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
.Range("A2").Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3)
End With

With this code I get in Column A the value "Total person A" and in Column C the total of the sum, but in this line I would also have in Column D a total (this is a text value)?

Any Ideas?

e.g.

see attachment!

Bob Phillips
04-21-2011, 07:06 AM
You example workbook doesn't match that code, there is no wsMain, wsMain1, etc.

MPDK166
04-21-2011, 08:28 AM
See new attachment!

Also what I want, is that in Column F the name of the sheet where data is coming from.

Can you help?

Bob Phillips
04-21-2011, 09:47 AM
I am not sure about the '... the sheet where the data is coming from ...'. Is that not the sheet being updated



Sub cons_ws()
Dim ws As Worksheet, wsMain As Worksheet, wsMain1 As Worksheet
Dim wsMain2 As Worksheet, wsMain3 As Worksheet, wsMain4 As Worksheet
Dim wsMain5 As Worksheet
Dim LR As Long, wsM_LR As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With

Set wsMain = Worksheets("Uren per medewerker")
Set wsMain1 = Worksheets("Voorblad")
Set wsMain2 = Worksheets("Regulatie + BD + TR")
Set wsMain3 = Worksheets("Security + L&F")
Set wsMain4 = Worksheets("Extra Werk")
Set wsMain5 = Worksheets("VC")

If Cells(2, 1) <> "" Then wsMain.Range("A2:E65536").EntireRow.Delete

For Each ws In Worksheets
wsM_LR = wsMain.Cells.Find("*", , , , xlByRows, xlPrevious).Row
If UCase(ws.Name) <> UCase(wsMain.Name) And UCase(ws.Name) <> UCase(wsMain1.Name) And UCase(ws.Name) <> UCase(wsMain2.Name) And UCase(ws.Name) <> UCase(wsMain3.Name) And UCase(ws.Name) <> UCase(wsMain4.Name) And UCase(ws.Name) <> UCase(wsMain5.Name) Then
With ws
LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
.Range("C7:C" & LR).Copy Destination:=wsMain.Cells(wsM_LR + 1, "A")
.Range("B7:B" & LR).Copy Destination:=wsMain.Cells(wsM_LR + 1, "B")
.Range("E7:E" & LR).Copy Destination:=wsMain.Cells(wsM_LR + 1, "C")
.Range("G7:G" & LR).Copy Destination:=wsMain.Cells(wsM_LR + 1, "D")
.Range("F7:F" & LR).Copy Destination:=wsMain.Cells(wsM_LR + 1, "E")
End With
End If
Next ws

Set MyRange = Range("D:D")
With MyRange

.Replace What:="1", Replacement:="SDBV", LookAt:=xlWhole
.Replace What:="2", Replacement:="Creyfs", LookAt:=xlWhole
.Replace What:="3", Replacement:="Schiphol College", LookAt:=xlWhole
.Replace What:="4", Replacement:="ROC", LookAt:=xlWhole
.Replace What:="5", Replacement:="I-Sec", LookAt:=xlWhole
.Replace What:="6", Replacement:="Delta Safe", LookAt:=xlWhole
.Replace What:="7", Replacement:="Hago Airport Security", LookAt:=xlWhole
.Replace What:="8", Replacement:="Hago Trolley Logistics"
.Replace What:="9", Replacement:="Hago Airport Services", LookAt:=xlWhole
.Replace What:="10", Replacement:="Vebego", LookAt:=xlWhole
.Replace What:="11", Replacement:="Tressunt", LookAt:=xlWhole
.Replace What:="12", Replacement:="Tence!", LookAt:=xlWhole
.Replace What:="13", Replacement:="Tence! Payroll", LookAt:=xlWhole
End With

With wsMain

.Columns("A:E").Sort Key1:=Range("A2"), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
.Range("A2").Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3)
End With

Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

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

With ActiveSheet
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = .UsedRange.Cells(1).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For Lrow = Lastrow To Firstrow Step -1

If Not IsError(.Cells(Lrow, "A").Value) Then

If .Cells(Lrow, "A").Value = "" Then

.Cells(Lrow, "A").EntireRow.Delete
ElseIf .Cells(Lrow, "D").Value2 = "" Then

.Cells(Lrow, "D").Value2 = .Cells(Lrow - 1, "D").Value2
End If
End If
Next Lrow
End With

ActiveWindow.View = ViewMode
Set wsMain = Nothing
With Application

.ScreenUpdating = True
.Calculation = CalcMode
.DisplayAlerts = True
End With
End Sub

MPDK166
04-22-2011, 02:06 AM
The code works fine! I see you made some changes in the code for better effeciency etc. :D

What I mean by the 'where the data is coming from....' is:

The data which is set in wsmain comes from all the other sheets, on each line (in column F) I want to be set from which sheet this data is coming from.

Bob Phillips
04-22-2011, 03:09 AM
Sub cons_ws()
Dim ws As Worksheet, wsMain As Worksheet, wsMain1 As Worksheet
Dim wsMain2 As Worksheet, wsMain3 As Worksheet, wsMain4 As Worksheet
Dim wsMain5 As Worksheet
Dim LR As Long, wsM_LR As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With

Set wsMain = Worksheets("Uren per medewerker")
Set wsMain1 = Worksheets("Voorblad")
Set wsMain2 = Worksheets("Regulatie + BD + TR")
Set wsMain3 = Worksheets("Security + L&F")
Set wsMain4 = Worksheets("Extra Werk")
Set wsMain5 = Worksheets("VC")

If Cells(2, 1) <> "" Then wsMain.Range("A2:E65536").EntireRow.Delete

For Each ws In Worksheets
wsM_LR = wsMain.Cells.Find("*", , , , xlByRows, xlPrevious).Row
If UCase(ws.Name) <> UCase(wsMain.Name) And UCase(ws.Name) <> UCase(wsMain1.Name) And UCase(ws.Name) <> UCase(wsMain2.Name) And UCase(ws.Name) <> UCase(wsMain3.Name) And UCase(ws.Name) <> UCase(wsMain4.Name) And UCase(ws.Name) <> UCase(wsMain5.Name) Then
With ws
LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
.Range("C7:C" & LR).Copy Destination:=wsMain.Cells(wsM_LR + 1, "A")
.Range("B7:B" & LR).Copy Destination:=wsMain.Cells(wsM_LR + 1, "B")
.Range("E7:E" & LR).Copy Destination:=wsMain.Cells(wsM_LR + 1, "C")
.Range("G7:G" & LR).Copy Destination:=wsMain.Cells(wsM_LR + 1, "D")
.Range("F7:F" & LR).Copy Destination:=wsMain.Cells(wsM_LR + 1, "E")
wsMain.Cells(wsM_LR + 1, "F").Resize(LR - 6).Value2 = ws.Name
End With
End If
Next ws

Set MyRange = Range("D:D")
With MyRange

.Replace What:="1", Replacement:="SDBV", LookAt:=xlWhole
.Replace What:="2", Replacement:="Creyfs", LookAt:=xlWhole
.Replace What:="3", Replacement:="Schiphol College", LookAt:=xlWhole
.Replace What:="4", Replacement:="ROC", LookAt:=xlWhole
.Replace What:="5", Replacement:="I-Sec", LookAt:=xlWhole
.Replace What:="6", Replacement:="Delta Safe", LookAt:=xlWhole
.Replace What:="7", Replacement:="Hago Airport Security", LookAt:=xlWhole
.Replace What:="8", Replacement:="Hago Trolley Logistics"
.Replace What:="9", Replacement:="Hago Airport Services", LookAt:=xlWhole
.Replace What:="10", Replacement:="Vebego", LookAt:=xlWhole
.Replace What:="11", Replacement:="Tressunt", LookAt:=xlWhole
.Replace What:="12", Replacement:="Tence!", LookAt:=xlWhole
.Replace What:="13", Replacement:="Tence! Payroll", LookAt:=xlWhole
End With

With wsMain

.Columns("A:E").Sort Key1:=Range("A2"), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
.Range("A2").Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3)
End With

Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

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

With ActiveSheet
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = .UsedRange.Cells(1).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For Lrow = Lastrow To Firstrow Step -1

If Not IsError(.Cells(Lrow, "A").Value) Then

If .Cells(Lrow, "A").Value = "" Then

.Cells(Lrow, "A").EntireRow.Delete
ElseIf .Cells(Lrow, "D").Value2 = "" Then

.Cells(Lrow, "D").Value2 = .Cells(Lrow - 1, "D").Value2
End If
End If
Next Lrow
End With

ActiveWindow.View = ViewMode
Set wsMain = Nothing
With Application

.ScreenUpdating = True
.Calculation = CalcMode
.DisplayAlerts = True
End With
End Sub