PDA

View Full Version : Solved: Make a Summary Sheet



jammer6_9
07-02-2013, 08:47 AM
Below code gives me specific row which row 6 to copy specific values. Now i want to copy all values which is not null from row 6 to row 75 :dunno


Sub Make_Summary()

Dim Ws As Worksheet, LstRw As Long
LstRw = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row

With Sheets("Summary")
.Range("A3:B" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets

If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then

.Cells(NxtRw, "A").Value = Ws.Range("a6")
.Cells(NxtRw, "B").Value = Ws.Range("b6")
.Cells(NxtRw, "c").Value = Ws.Range("c6")
.Cells(NxtRw, "d").Value = Ws.Range("d6")
.Cells(NxtRw, "e").Value = Ws.Range("e6")
.Cells(NxtRw, "f").Value = Ws.Range("f6")
.Cells(NxtRw, "g").Value = Ws.Range("g6")


NxtRw = NxtRw + 1

End If
Next Ws
End With

End Sub

SamT
07-02-2013, 02:22 PM
Sheets("Summary").Rows("6:75").Copy
For Each ws In ThisWorkbook.Worksheets

If Not ws.Name = "Template" And Not ws.Name = "Summary" Then _
ws.Range("A3").PasteSpecial xlValues, SkipBlanks:=True
Next ws

PasteSpecial xlValues means only paste values. SkipBlanks:=True means don't paste Nulls.

jammer6_9
07-02-2013, 09:38 PM
It doesnt give me anything. Am i going to add this in my code? What I meant to say is how can I combine the code below to copy rows down in all the sheets source


Sub Row1()

Dim Ws As Worksheet, LstRw As Long
LstRw = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).row

With Sheets("Summary")
.Range("A3:g" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets

If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then

.Cells(NxtRw, "A").Value = Ws.Range("a6")
.Cells(NxtRw, "B").Value = Ws.Range("b6")
.Cells(NxtRw, "c").Value = Ws.Range("c6")
.Cells(NxtRw, "d").Value = Ws.Range("d6")
.Cells(NxtRw, "e").Value = Ws.Range("e6")
.Cells(NxtRw, "f").Value = Ws.Range("f6")
.Cells(NxtRw, "g").Value = Ws.Range("g6")

NxtRw = NxtRw + 1

.Cells(NxtRw, "A").Value = Ws.Range("a6")
.Cells(NxtRw, "B").Value = Ws.Range("b6")
.Cells(NxtRw, "c").Value = Ws.Range("c6")
.Cells(NxtRw, "d").Value = Ws.Range("d6")
.Cells(NxtRw, "e").Value = Ws.Range("e6")
.Cells(NxtRw, "f").Value = Ws.Range("h6")
.Cells(NxtRw, "g").Value = Ws.Range("i6")

NxtRw = NxtRw + 1

.Cells(NxtRw, "A").Value = Ws.Range("a6")
.Cells(NxtRw, "B").Value = Ws.Range("b6")
.Cells(NxtRw, "c").Value = Ws.Range("c6")
.Cells(NxtRw, "d").Value = Ws.Range("d6")
.Cells(NxtRw, "e").Value = Ws.Range("e6")
.Cells(NxtRw, "f").Value = Ws.Range("j6")
.Cells(NxtRw, "g").Value = Ws.Range("k6")


NxtRw = NxtRw + 1


End If
Next Ws
End With


End Sub

Sub Row2()

Dim Ws As Worksheet, LstRw As Long
LstRw = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).row

With Sheets("Summary")
' .Range("A3:g" & LstRw).ClearContents
LstRw = LstRw
For Each Ws In ThisWorkbook.Worksheets

If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then

.Cells(LstRw, "A").Value = Ws.Range("a7")
.Cells(LstRw, "B").Value = Ws.Range("b7")
.Cells(LstRw, "c").Value = Ws.Range("c7")
.Cells(LstRw, "d").Value = Ws.Range("d7")
.Cells(LstRw, "e").Value = Ws.Range("e7")
.Cells(LstRw, "f").Value = Ws.Range("f7")
.Cells(LstRw, "g").Value = Ws.Range("g7")

LstRw = LstRw + 1

.Cells(LstRw, "A").Value = Ws.Range("a7")
.Cells(LstRw, "B").Value = Ws.Range("b7")
.Cells(LstRw, "c").Value = Ws.Range("c7")
.Cells(LstRw, "d").Value = Ws.Range("d7")
.Cells(LstRw, "e").Value = Ws.Range("e7")
.Cells(LstRw, "f").Value = Ws.Range("h7")
.Cells(LstRw, "g").Value = Ws.Range("i7")

LstRw = LstRw + 1

.Cells(LstRw, "A").Value = Ws.Range("a7")
.Cells(LstRw, "B").Value = Ws.Range("b7")
.Cells(LstRw, "c").Value = Ws.Range("c7")
.Cells(LstRw, "d").Value = Ws.Range("d7")
.Cells(LstRw, "e").Value = Ws.Range("e7")
.Cells(LstRw, "f").Value = Ws.Range("j7")
.Cells(LstRw, "g").Value = Ws.Range("k7")


LstRw = LstRw + 1


End If
Next Ws
End With


End Sub




Sheets("Summary").Rows("6:75").Copy
For Each ws In ThisWorkbook.Worksheets

If Not ws.Name = "Template" And Not ws.Name = "Summary" Then _
ws.Range("A3").PasteSpecial xlValues, SkipBlanks:=True
Next ws

PasteSpecial xlValues means only paste values. SkipBlanks:=True means don't paste Nulls.

p45cal
07-02-2013, 11:47 PM
re:"copy all values which is not null"
SamT gave you a solution for exactly what you asked for, however I suspect that what you asked for is not what you wanted.
What "is not null"?:
Must all cells in a given row be "not null" (empty?)?
A whole row of empty cells from column A to G?
Just one of these cells in columns A to G in a given row?
Perhaps several empty cells in a given row?
or perhaps an empty cell in a specific column qualifies the row not to be copied?

Have you tried autofiltering the range to be copied before copying it? If that works, record a macro of your doing it and paste the code here - we'll tweak.

jammer6_9
07-03-2013, 12:05 AM
Yeah I guess I have ask a wrong question... Forgetting null, with my above code, instead of going row1 and row2 until row 75, is there a way to combine the codings?


re:"copy all values which is not null"
SamT gave you a solution for exactly what you saked for, however I suspect that what you asked for is not what you wanted.
What "is not null"?:
Must all cells in a given row be "not null" (empty?)?
A whole row of empty cells from column A to G?
Just one of these cells in columns A to G in a given row?
Perhaps several empty cells in a given row?
or perhaps an empty cell in a specific column qualifies the row not to be copied?

Have you tried autofiltering the range to be copied before copying it? If that works, record a macro of your doing it and paste the code here - we'll tweak.

p45cal
07-03-2013, 12:30 AM
Sub Make_Summary()
Dim Ws As Worksheet, LstRw As Long
With Sheets("Summary")
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A3:G" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets
If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then
.Cells(NxtRw, "A").Resize(70, 7).Value = Ws.Range("A6:G75").Value
NxtRw = NxtRw + 70
End If
Next Ws
End With
End Sub

jammer6_9
07-03-2013, 12:48 AM
Thaw was a fast consolidation of sheet :whistle: related to my post No.1... Could you check my post No.3 and check the possibility of combining it...


Sub Make_Summary()
Dim Ws As Worksheet, LstRw As Long
With Sheets("Summary")
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A3:G" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets
If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then
.Cells(NxtRw, "A").Resize(70, 7).Value = Ws.Range("A6:G75").Value
NxtRw = NxtRw + 70
End If
Next Ws
End With
End Sub

p45cal
07-03-2013, 12:59 AM
I'm not with you.
The macro Row1 in msg#3 seems to copy row 1 of the source sheet to the Summary sheet 3 times, and Row2 seems to do the same thing with row 2. This is what you want?

edit post posting: Oh, I see a difference now, the second and 3rd copies are different in the source columns.

jammer6_9
07-03-2013, 01:03 AM
The row 2 have different copy range


.Cells(NxtRw, "A").Value = Ws.Range("a6")
.Cells(NxtRw, "B").Value = Ws.Range("b6")
.Cells(NxtRw, "c").Value = Ws.Range("c6")
.Cells(NxtRw, "d").Value = Ws.Range("d6")
.Cells(NxtRw, "e").Value = Ws.Range("e6")
.Cells(NxtRw, "f").Value = Ws.Range("f6")
.Cells(NxtRw, "g").Value = Ws.Range("g6")

NxtRw = NxtRw + 1

.Cells(NxtRw, "A").Value = Ws.Range("a6")
.Cells(NxtRw, "B").Value = Ws.Range("b6")
.Cells(NxtRw, "c").Value = Ws.Range("c6")
.Cells(NxtRw, "d").Value = Ws.Range("d6")
.Cells(NxtRw, "e").Value = Ws.Range("e6")
.Cells(NxtRw, "f").Value = Ws.Range("h6")
.Cells(NxtRw, "g").Value = Ws.Range("i6")

NxtRw = NxtRw + 1

.Cells(NxtRw, "A").Value = Ws.Range("a6")
.Cells(NxtRw, "B").Value = Ws.Range("b6")
.Cells(NxtRw, "c").Value = Ws.Range("c6")
.Cells(NxtRw, "d").Value = Ws.Range("d6")
.Cells(NxtRw, "e").Value = Ws.Range("e6")
.Cells(NxtRw, "f").Value = Ws.Range("j6")
.Cells(NxtRw, "g").Value = Ws.Range("k6")



I'm not with you.
The macro Row1 in msg#3 seems to copy row 1 of the source sheet to the Summary sheet 3 times, and Row2 seems to do the same thing with row 2. This is what you want?

jammer6_9
07-03-2013, 01:08 AM
Hi am attaching the file :thumb

p45cal
07-03-2013, 01:36 AM
I haven't looked at your attachment yet, but try:Sub Make_Summary()
Dim Ws As Worksheet, LstRw As Long
With Sheets("Summary")
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A3:G" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets
If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then
For Each rw In Ws.Range("A6:E75").Rows
.Cells(NxtRw, "A").Resize(3, 5).Value = rw.Value
For i = 0 To 2
.Cells(NxtRw, "F").Offset(i).Resize(, 2).Value = rw.Offset(, 5 + i * 2).Resize(, 2).Value
Next i
NxtRw = NxtRw + 3
Next rw
End If
Next Ws
End With
End Sub

jammer6_9
07-03-2013, 01:57 AM
Exactly what I was asking for :beerchug: Thanks!

Next to this is Filtering the summary which I guess I can do it :think: but then I know that you will be here in case!


I haven't looked at your attachment yet, but try:Sub Make_Summary()
Dim Ws As Worksheet, LstRw As Long
With Sheets("Summary")
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A3:G" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets
If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then
For Each rw In Ws.Range("A6:E75").Rows
.Cells(NxtRw, "A").Resize(3, 5).Value = rw.Value
For i = 0 To 2
.Cells(NxtRw, "F").Offset(i).Resize(, 2).Value = rw.Offset(, 5 + i * 2).Resize(, 2).Value
Next i
NxtRw = NxtRw + 3
Next rw
End If
Next Ws
End With
End Sub

p45cal
07-03-2013, 02:03 AM
an update after looking at your file:Sub Make_Summary()
Dim Ws As Worksheet, LstRw As Long
With Sheets("Summary")
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A3:G" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets
If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then
For Each rw In Ws.Range("A6:E75").Rows
For i = 0 To 2
If Application.CountBlank(rw.Offset(, 5 + i * 2).Resize(, 2)) < 2 Then
.Cells(NxtRw, "A").Resize(, 5).Value = rw.Value
.Cells(NxtRw, "F").Resize(, 2).Value = rw.Offset(, 5 + i * 2).Resize(, 2).Value
NxtRw = NxtRw + 1
End If
Next i
Next rw
End If
Next Ws
End With
End Sub

jammer6_9
07-03-2013, 02:11 AM
Just one thing I have notice, there was some employee but not all record in second row that is missing, Column I of the source sheets.

jammer6_9
07-03-2013, 02:12 AM
Oppps still some records are not showing with the update

jammer6_9
07-03-2013, 02:19 AM
an update after looking at your file:Sub Make_Summary()
Dim Ws As Worksheet, LstRw As Long
With Sheets("Summary")
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A3:G" & LstRw).ClearContents
NxtRw = 3
For Each Ws In ThisWorkbook.Worksheets
If Not Ws.Name = "Template" And Not Ws.Name = "Summary" Then
For Each rw In Ws.Range("A6:E75").Rows
For i = 0 To 2
If Application.CountBlank(rw.Offset(, 5 + i * 2).Resize(, 2)) < 2 Then
.Cells(NxtRw, "A").Resize(, 5).Value = rw.Value
.Cells(NxtRw, "F").Resize(, 2).Value = rw.Offset(, 5 + i * 2).Resize(, 2).Value
NxtRw = NxtRw + 1
End If
Next i
Next rw
End If
Next Ws
End With
End Sub

p45cal
07-03-2013, 02:56 AM
In Excel's Options, you have in the Advanced section, in the Display Options for this worksheet in the Show a zero in cells that have zero value check box unchecked. The values that are apparently missing are all 12:00AM. They are there (select one and look at the formula bar).

jammer6_9
07-03-2013, 02:59 AM
Damn me:banghead: Great! Thanks once again!:thumb


In Excel's Options, you have in the Advanced section, in the Display Options for this worksheet in the Show a zero in cells that have zero value check box unchecked. The values that are apparently missing are all 12:00AM. They are there (select one and look at the formula bar).