PDA

View Full Version : very simple but stumping me big time



Immatoity
02-06-2009, 12:19 PM
hi

got a workbook with anywhere between 1-50 sheets in it. All sheets formatted the same way and have autosums in the same cell reference in each.

However the sheet names will always be different and I wont know until the end of the month how many sheets there are.

I need to get some code to

a) create a sheet called Summary
b) that sheet (Summary) needs to give me 3 totals ( which are derived from cell b2, e2, and f2 of every other sheet in the workbook)

I dont want to have to do this manually for obvious reasons but need some help asap on this...

georgiboy
02-06-2009, 12:48 PM
This will add the values of Range("A1") in all sheets and then place the result in Range("A1") in the summary sheet. Hope this gives you some ideas.

Sub Summary()
Dim sh As Worksheet
Dim x As Integer

' loop through sheets and add the values in range A1
For Each sh In ActiveWorkbook.Sheets
x = x + Range("A1").Value
Next

' add the summary sheet
Sheets.Add.Name = "Summary"
'place the added total to range A1 in the summary sheet
Sheets("Summary").Range("A1").Value = x

End Sub

Simon Lloyd
02-06-2009, 12:56 PM
This should do what you need:Dim Sh As Worksheet
Sheets.Add
ActiveSheet.Name = "Summary"
For Each Sh In Sheets
If Sh.Name <> "Summary" Then
Sh.Range("B2").Copy Destination:=Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Sh.Range("E2").Copy Destination:=Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Offset(0, 1)
Sh.Range("F2").Copy Destination:=Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Offset(0, 2)
End If
Next Sh

Immatoity
02-06-2009, 01:24 PM
thanks for the replies will try this in a short while and report back

many thanks once again

:)

Immatoity
02-06-2009, 01:56 PM
hmm this isnt quite working as its copying the formulas across rather than the values..

Simon Lloyd
02-06-2009, 02:38 PM
You didn't mention just copying values
Dim Sh As Worksheet
Sheets.Add
ActiveSheet.Name = "Summary"
For Each Sh In Sheets
If Sh.Name <> "Summary" Then
Sh.Range("B2").Copy
Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) .PasteSpecial Paste:=xlPasteValues
Sh.Range("E2").Copy
Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Offset(0, 1) .PasteSpecial Paste:=xlPasteValues
Sh.Range("F2").Copy
Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Offset(0, 2) .PasteSpecial Paste:=xlPasteValues
End If
Next Sh

Immatoity
02-06-2009, 03:10 PM
Simon..sorry my bad no I didnt...that works a tad better but..

it is pulling data across however its doing it as follows
(summary sheet)
cell a2 now has the value from cell b2 in the first sheet
cell b2 now has the value from cell b2 in the second sheet
etc

I want it too add all of the cells b2 in all other sheets and enter one total in cell A2 of the summary sheet ( ie one total)

sorry if i wasn't clear..been a long while since i used vba

EDIT : actually the way its doing it could work as long as I could somehow get the "sheet name" of each individual sheet next to the total in cell a2/b2/c2 etc of summary sheet..is that possible

mdmackillop
02-06-2009, 04:59 PM
This will add a sheet and insert formulae summing all sheets after the first.

Option Explicit
Sub CreateSummary()
Dim ws As Worksheet
Dim Strt As String, Endd As String, MySum As String
Set ws = Sheets.Add(before:=Sheets(1))
ws.Name = "Summary"
Strt = Sheets(2).Name
Endd = Sheets(Sheets.Count).Name
MySum = "=Sum(" & Strt & ":" & Endd & "!"
ws.Cells(1, 1).Formula = MySum & "B2)"
ws.Cells(2, 1).Formula = MySum & "E2)"
ws.Cells(3, 1).Formula = MySum & "F2)"
End Sub

Immatoity
02-06-2009, 06:11 PM
This will add a sheet and insert formulae summing all sheets after the first.

Option Explicit
Sub CreateSummary()
Dim ws As Worksheet
Dim Strt As String, Endd As String, MySum As String
Set ws = Sheets.Add(before:=Sheets(1))
ws.Name = "Summary"
Strt = Sheets(2).Name
Endd = Sheets(Sheets.Count).Name
MySum = "=Sum(" & Strt & ":" & Endd & "!"
ws.Cells(1, 1).Formula = MySum & "B2)"
ws.Cells(2, 1).Formula = MySum & "E2)"
ws.Cells(3, 1).Formula = MySum & "F2)"
End Sub

Hi that seems to fail on the line "ws.cells(1, 1).Formula = MySum & "B2)"

mdmackillop
02-06-2009, 06:36 PM
Does it fail if you enter the formula manually? e.g.
=Sum(Sheets1:Sheets5!B2)

Immatoity
02-07-2009, 01:45 AM
Does it fail if you enter the formula manually? e.g.
=Sum(Sheets1:Sheets5!B2)

yes it does ..it fails and an explorer browser opens asking me to look for "Sheets 5" etc

Simon Lloyd
02-07-2009, 01:49 AM
Thats becaise there is no sheet 5, it will be because it is counting the summary sheet (named Summary not Sheet5), perhapsSheets(Sheets.Count-1).Name

Immatoity
02-07-2009, 02:22 AM
hi sorry I am a bit confused..

I create a sheet called summary then in there manually enter that formula
=Sum(Sheets1:Sheets5!B2) ..even if I change it to =Sum(Sheets1:Sheets2!:B2) it fails..

currently there are 3 other named sheets in the workbook, but this can be anything between 1-100 sheets a month

sorry if I am being stupid

mdmackillop
02-07-2009, 05:07 AM
This example works for me

mdmackillop
02-07-2009, 05:09 AM
Thats becaise there is no sheet 5, it will be because it is counting the summary sheet (named Summary not Sheet5), perhapsSheets(Sheets.Count-1).Name

Simon,
The code place the Summary as the first sheet to avoid this problem. I'm on 2007. Could this be a version thing?
Regards
Malcolm

Immatoity
02-07-2009, 05:25 AM
I am on v2003..

This is the code I am using (tweaked a bit as only need totals of 2 cells in each now)

Sub CreateSummary()
Dim ws As Worksheet
Dim Strt As String, Endd As String, MySum As String
Set ws = Sheets.Add(before:=Sheets(1))
ws.Name = "Summary"
Strt = Sheets(2).Name
Endd = Sheets(Sheets.Count).Name
MySum = "=Sum(" & Strt & ":" & Endd & "!"
ws.Cells(1, 1).Formula = MySum & "B2)"
ws.Cells(2, 1).Formula = MySum & "g2)"
ActiveCell.FormulaR1C1 = "Total Price for Month"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Includes Mileage/Delivery Charges"
columns("A:B").Select
Application.CutCopyMode = False
Selection.NumberFormat = "#,##0.00"
columns("A:B").EntireColumn.AutoFit

End Sub

still falls over at the line ws.Cells(1, 1).Formula = MySum & "B2)"
just a note my current sheet names are "SE-9-09", "SE-9-10", "SE-9-08"..not sure if thats relevant? (they wont always be sequential)

mdmackillop
02-07-2009, 05:38 AM
Can you post a sample?

Immatoity
02-07-2009, 06:10 AM
ok..here is the sample attached..

mdmackillop
02-07-2009, 07:04 AM
Looks like the sheet names were the problem. Spaces/punctuation need to be handled by using single quotes.

Sub CreateSummary()
Dim ws As Worksheet
Dim Strt As String, Endd As String, MySum As String
Set ws = Sheets.Add(before:=Sheets(1))
ws.Name = "Summary"
Strt = "'" & Sheets(2).Name
Endd = Sheets(Sheets.Count).Name & "'"
MySum = "=Sum(" & Strt & ":" & Endd & "!"
ws.Cells(2, 1).Formula = MySum & "B2)"
ws.Cells(3, 1).Formula = MySum & "g1)"
ws.Cells(1, 1).Resize(, 2) = Array("Total Price for Month", "Includes Mileage/Delivery Charges")
Columns("A:B").NumberFormat = "#,##0.00"
Columns("A:B").EntireColumn.AutoFit
End Sub

Simon Lloyd
02-07-2009, 09:04 AM
Maybe,

Option Explicit
Sub CreateSummary()
Dim ws As Worksheet
Dim Strt As String, Endd As String, MySum As String
Set ws = Sheets.Add(before:=Sheets(1))
ws.Name = "Summary"
Strt = Sheets(2).Name
Endd = Sheets(Sheets.Count).Name
MySum = "=Sum(" & Strt & "!" & ":" & Endd & "!"
ws.Cells(1, 1).Formula = MySum & "B2)"
ws.Cells(2, 1).Formula = MySum & "E2)"
ws.Cells(3, 1).Formula = MySum & "F2)"
End Subas i noticed in 2007 you only need use ! at the end of the formula but maybe, in 97 - 2003 you have to use it for both sheet arguments.

As for my previous posting, i have to admit to testing neither, however, the op probably has a hidden sheet.

Immatoity
02-07-2009, 09:18 AM
mdamackillop...works a treat..

Simon..no hidden sheets..however

have just created a sheet called "Doug Only" and put a button on it (otherwise how can the end user run the macro - they are more of a novice than me)..

I also want to include some code that will not run the macro again if sheet called summary has already been created?

I realise the sheet with a box on it might not be the most elegant solution..

Simon Lloyd
02-07-2009, 09:21 AM
please post a workbook, remove sensitve information but the structure and formuale should remain the same, the data should also be of the same format.

Then there's no guesswork ;)

Immatoity
02-07-2009, 09:30 AM
cheers...here it is..as you can tell I am a bit out of touch with vba

GTO
02-07-2009, 10:58 AM
Greetings,

Just to blocking secondary creation, maybe:

Sub CreateSummary()
Dim ws As Worksheet
Dim Strt As String, Endd As String, MySum As String

For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Summary" Then
MsgBox """Summary"" sheet already exists.", vbCritical, ""
Exit Sub
End If
Next


Set ws = Sheets.Add(before:=Sheets(1))
ws.Name = "Summary"
Strt = "'" & Sheets(2).Name
Endd = Sheets(Sheets.Count).Name & "'"
MySum = "=Sum(" & Strt & ":" & Endd & "!"
ws.Cells(2, 1).Formula = MySum & "B2)"
ws.Cells(3, 1).Formula = MySum & "g1)"
ws.Cells(1, 1).Resize(, 2) = Array("Total Price for Month", _
"Includes Mileage/Delivery Charges")
columns("A:B").NumberFormat = "#,##0.00"
columns("A:B").EntireColumn.AutoFit
Range("A3").Select
Selection.Cut
Range("B2").Select
ActiveSheet.Paste
Range("C1").Select
End Sub
Hope that helps,

Mark

Immatoity
02-07-2009, 11:50 AM
wicked cheers

mdmackillop
02-07-2009, 11:58 AM
I would do it slightly differently. Add the Summary Sheet to start with. Use the code to clear previous data, or add the sheet if it does not exist

Sub CreateSummary()
Dim ws As Worksheet
Dim Strt As String, Endd As String, MySum As String

On Error Resume Next
Set ws = Sheets("Summary")
If Not ws Is Nothing Then
ws.Cells.ClearContents
Else
Set ws = Sheets.Add(before:=Sheets(1))
ws.Name = "Summary"
End If
On Error GoTo 0


Strt = "'" & Sheets(2).Name
Endd = Sheets(Sheets.Count).Name & "'"
MySum = "=Sum(" & Strt & ":" & Endd & "!"
ws.Cells(2, 1).Formula = MySum & "B2)"
ws.Cells(2, 2).Formula = MySum & "g1)"
ws.Cells(1, 1).Resize(, 2) = Array("Total Price for Month", _
"Includes Mileage/Delivery Charges")
columns("A:B").NumberFormat = "#,##0.00"
columns("A:B").EntireColumn.AutoFit
Range("C1").Select
End Sub

GTO
02-07-2009, 01:12 PM
ACK(!) and my total bad.

Malcom's "slightly different" should read "gosh, you might want to write something that works..."

My apologies, as I blindly missed the formula needing updated for added sheets/cells to sum.

Mark

(Thank you Malcom. I will go sit in the corner now :doh:.)

mdmackillop
02-07-2009, 02:16 PM
Just for practice, this will add a command button to the Summary sheet as well
Sub CreateSummary()
Dim ws As Worksheet
Dim Strt As String, Endd As String, MySum As String
Dim OLE As Object, sh As String

On Error Resume Next
Set ws = Sheets("Summary")
If Not ws Is Nothing Then
ws.Cells.ClearContents
Else
Application.ScreenUpdating = False
'Create sheet, add button and code
Set ws = Sheets.Add(before:=Sheets(1))
ws.Name = "Summary"
Set OLE = Sheets(1).OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=391.5, Top:=32.25, Width:=167.25, Height:=67.5)
DoEvents
Sheets(1).CommandButton1.Caption = "Create Summmary"
DoEvents
AddSheetCode Sheets(1).CodeName
Application.ScreenUpdating = True
End If

On Error GoTo 0


Strt = "'" & Sheets(2).Name
Endd = Sheets(Sheets.Count).Name & "'"
MySum = "=Sum(" & Strt & ":" & Endd & "!"
ws.Cells(2, 1).Formula = MySum & "B2)"
ws.Cells(2, 2).Formula = MySum & "g1)"
ws.Cells(1, 1).Resize(, 2) = Array("Total Price for Month", _
"Includes Mileage/Delivery Charges")
Columns("A:B").NumberFormat = "#,##0.00"
Columns("A:B").EntireColumn.AutoFit
Range("C1").Select



End Sub

Sub AddSheetCode(shCode As String)
Dim strCode As String
Dim WB As Workbook
Dim sh
Dim I As Integer
Set WB = ActiveWorkbook

'Create button code
strCode = "Private Sub CommandButton1_Click()" & vbCr & _
"CreateSummary" & vbCr & _
"End Sub"

'Look for Summary code sheet
For I = 1 To WB.VBProject.VBComponents.Count
If WB.VBProject.VBComponents.Item(I).Name = shCode Then
Exit For
End If
Next
'Write code to Summary module
WB.VBProject.VBComponents.Item(I).CodeModule.AddFromString (strCode)
Set WB = Nothing

End Sub

Immatoity
02-07-2009, 02:30 PM
Thanks all... excellent forum...will try that code mdm

thinking more about this this will be a file thats name changes monthly ( ie end user will create all the tabs in a month then create a summary using the code provided here :) )..then they will need to start a new workbook for the next month

but I am thinking they might just then save the file with a new name and delete the tabs but leave the summary there if that makes sense? I think that might cause issues...so...

I need to somehow create some code that , after summary creation etc "creates a new file" copying across the summary macro but deleting all the tabs from the previous month apart from two...being "for doug only" which contains the button and one of other the tabs (as that has a sort of "template" they can use if that makes sense)

I am guessing a box that pops up asking them to save the new file etc

hope this makes sense??

mdmackillop
02-07-2009, 03:17 PM
Save the file with the Summary and other sheets as desired as a template
(xlt file) The new workbook should be created from the template.

Immatoity
02-09-2009, 12:48 PM
Just for practice, this will add a command button to the Summary sheet as well
Sub CreateSummary()
Dim ws As Worksheet
Dim Strt As String, Endd As String, MySum As String
Dim OLE As Object, sh As String

On Error Resume Next
Set ws = Sheets("Summary")
If Not ws Is Nothing Then
ws.Cells.ClearContents
Else
Application.ScreenUpdating = False
'Create sheet, add button and code
Set ws = Sheets.Add(before:=Sheets(1))
ws.Name = "Summary"
Set OLE = Sheets(1).OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=391.5, Top:=32.25, Width:=167.25, Height:=67.5)
DoEvents
Sheets(1).CommandButton1.Caption = "Create Summmary"
DoEvents
AddSheetCode Sheets(1).CodeName
Application.ScreenUpdating = True
End If

On Error GoTo 0


Strt = "'" & Sheets(2).Name
Endd = Sheets(Sheets.Count).Name & "'"
MySum = "=Sum(" & Strt & ":" & Endd & "!"
ws.Cells(2, 1).Formula = MySum & "B2)"
ws.Cells(2, 2).Formula = MySum & "g1)"
ws.Cells(1, 1).Resize(, 2) = Array("Total Price for Month", _
"Includes Mileage/Delivery Charges")
Columns("A:B").NumberFormat = "#,##0.00"
Columns("A:B").EntireColumn.AutoFit
Range("C1").Select



End Sub

Sub AddSheetCode(shCode As String)
Dim strCode As String
Dim WB As Workbook
Dim sh
Dim I As Integer
Set WB = ActiveWorkbook

'Create button code
strCode = "Private Sub CommandButton1_Click()" & vbCr & _
"CreateSummary" & vbCr & _
"End Sub"

'Look for Summary code sheet
For I = 1 To WB.VBProject.VBComponents.Count
If WB.VBProject.VBComponents.Item(I).Name = shCode Then
Exit For
End If
Next
'Write code to Summary module
WB.VBProject.VBComponents.Item(I).CodeModule.AddFromString (strCode)
Set WB = Nothing

End Sub


hi I did that but the summary doesnt work if I add another sheet afterwards with values in it? The summary sheet doesnt include it

Immatoity
02-09-2009, 12:58 PM
sorry off on a tangent...can I somehow protect the template so the end user cannot save it with the same name (therefore leaving my template intact)

I was thinking a message box to tell them to save this file as another name etc and make sure its xls

mdmackillop
02-09-2009, 04:00 PM
Your end user should not be opening the template file. but creating a new file based upon the template. Maybe some education is required.

Immatoity
04-27-2009, 05:25 AM
hi back again...

the end user now wants the summary to list each tab name ( can be 1-100 of them randomly named) and then the totals for each sheet next to the tab name..

mdmackillop
04-27-2009, 05:31 AM
Can you repost the current version of your workbook so we're starting from the same point.

Immatoity
04-27-2009, 05:51 AM
yeah of course..still rubbish at this so most appreciative of the help on here

what I need is

Column A of Summary tab to list the sheet names ( and cell a1 needs a heading "SE Number")
Cell b1 to have a header "Total Batch Price" and then list value from cell a2 in each sheet below
Cell c1 to have a header "Total Unit Price for month" and then list value from cell b2 in each sheet below
Cell d1 to have a header "Total Spares" and then list value from cell c2 in each sheet below
Cell e1 to have a header "Total Delivery Charges" and then list value from cell d2 in each sheet below
Cell f1 to have a header "Total Hours" and then list value from cell e2 in each sheet below
Cell g1 to have a header "Total Miles" and then list value from cell f2 in each sheet below
Cell h1 to have a header "Total DT Workshop Value" and then list value from cell b26 in each sheet below

I then want an autosum at the bottom of columns b-h ( obviously don't know the end row as will be different each time)

ta

Immatoity
04-27-2009, 06:21 AM
actually I think you might have answered this for me before ( the tab name issue)

http://www.vbaexpress.com/forum/showthread.php?t=25044&highlight=summary

Immatoity
04-28-2009, 12:44 PM
yeah of course..still rubbish at this so most appreciative of the help on here

what I need is

Column A of Summary tab to list the sheet names ( and cell a1 needs a heading "SE Number")
Cell b1 to have a header "Total Batch Price" and then list value from cell a2 in each sheet below
Cell c1 to have a header "Total Unit Price for month" and then list value from cell b2 in each sheet below
Cell d1 to have a header "Total Spares" and then list value from cell c2 in each sheet below
Cell e1 to have a header "Total Delivery Charges" and then list value from cell d2 in each sheet below
Cell f1 to have a header "Total Hours" and then list value from cell e2 in each sheet below
Cell g1 to have a header "Total Miles" and then list value from cell f2 in each sheet below
Cell h1 to have a header "Total DT Workshop Value" and then list value from cell b26 in each sheet below

I then want an autosum at the bottom of columns b-h ( obviously don't know the end row as will be different each time)

ta
actually..after speaking to the user last night the plot thickens...and I definitely need help!

I now need..deep breath

Column A of Summary tab to list the sheet names ( and cell a1 needs a heading "Sheet Name")
Column B needs to then have a header "Site" - it then needs to list the value from cell A4 in each sheet name next to the sheet name in the summary. column A. I have no idea how to do this
Column C needs to then have a header "Engine No" - it then needs to list the value from cell B4 in each sheet name
Column D needs to then have a header "Engine Type" - it then needs to list the value from cell C4 in each sheet name
Column E needs to then have a header "Desc" - it then needs to list the value from cell D4 in each sheet name
Column F needs to then have a header "Engine Hrs" - it then needs to list the value from cell e4 in each sheet name
Cell G1 to have a header "Total Batch Price" and then list value from cell a2 in each sheet below
Cell H1 to have a header "Total Unit Price for month" and then list value from cell f2 in each sheet below
Cell I1 to have a header "Total Spares" and then list value from cell H2 in each sheet below
Cell J1 to have a header "Total Delivery Charges" and then list value from cell J2 in each sheet below
Cell K1 to have a header "Total Hours" and then list value from cell K2 in each sheet below
Cell L1 to have a header "Total Miles" and then list value from cell L2 in each sheet below
Cell M1 to have a header "Total DT Workshop Value" and then list value from cell b27 in each sheet below


hope this makes sense...will attach where I am currently at...I can "autosum" the values in each sheet returning one value in the summary but dont know how to get it to simply list the individual values for the referenced cell in each sheet?

There is also a sheet called "Doug ONLY" that I don't want referenced in the summary at all...

please please help moi

mdmackillop
04-28-2009, 01:20 PM
Try this for a starter. You should be able to fill in the gaps

Option Explicit
Sub CreateSummary()
Dim ws As Worksheet, sh As Worksheet
Dim Strt As String, Endd As String, MySum As String
Dim Rw As Long, i As Long
On Error Resume Next
Set ws = Sheets("Summary")
If ws Is Nothing Then Set ws = Sheets.Add(before:=Sheets(1))
ws.Name = "Summary"
Rw = 1
With ws
.Cells(1, 1) = "Sheet Name"
.Cells(1, 2).Resize(, 5) = Array("Site", "Eng No", "Eng Type", "Desc", "Eng Hrs")
For i = 2 To Sheets.Count
Rw = Rw + 1
Set sh = Sheets(i)
.Cells(Rw, 1) = sh.Name
.Cells(Rw, 2) = sh.Range("A4")
.Cells(Rw, 3) = sh.Range("B4")
Next
End With
End Sub

Immatoity
04-28-2009, 02:00 PM
cool...thanks ever so much..code now looks like this

Option Explicit
Sub CreateSummary()
Dim ws As Worksheet, sh As Worksheet
Dim Strt As String, Endd As String, MySum As String
Dim Rw As Long, i As Long
On Error Resume Next
Set ws = Sheets("Summary")
If ws Is Nothing Then Set ws = Sheets.Add(before:=Sheets(1))
ws.Name = "Summary"
Rw = 1
With ws
.Cells(1, 1) = "Sheet Name"
.Cells(1, 2).Resize(, 13) = Array("Site", "Engine No", "Engine Type", "Desc", "Eng Hrs", "Total Batch Price", "Total Unit Price for Month", "Total Spares", "Total Delivery Charges", "Total Hours", "Total Miles", "Total DT Workshop Unit Value", "Order No")
For i = 2 To Sheets.Count
Rw = Rw + 1
Set sh = Sheets(i)
.Cells(Rw, 1) = sh.Name
.Cells(Rw, 2) = sh.Range("A4")
.Cells(Rw, 3) = sh.Range("B4")
.Cells(Rw, 4) = sh.Range("C4")
.Cells(Rw, 5) = sh.Range("d4")
.Cells(Rw, 6) = sh.Range("e4")
.Cells(Rw, 7) = sh.Range("a2")
.Cells(Rw, 8) = sh.Range("f2")
.Cells(Rw, 9) = sh.Range("h2")
.Cells(Rw, 10) = sh.Range("j2")
.Cells(Rw, 11) = sh.Range("k2")
.Cells(Rw, 12) = sh.Range("L2")
.Cells(Rw, 13) = sh.Range("b27")
.Cells(Rw, 14) = sh.Range("g2")

Next
End With
Columns("A:n").EntireColumn.AutoFit
Columns("g:h").NumberFormat = "#,##0.00"
Columns("J:J").NumberFormat = "#,##0.00"
Cells.Find(What:="DOUG", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Selection.EntireRow.Delete

End Sub

just got to remember how to autosum a column when it can be 3-65000 rows long..think its xlup or xlend or something similar

mdmackillop
04-28-2009, 02:15 PM
.Cells(Rw, 14) = sh.Range("g2")
Next
.Cells(Rw + 1, 2).Resize(, 13).FormulaR1C1 = "=SUM(R2C:R[-1]C)"

Immatoity
04-28-2009, 02:26 PM
fantastic...thanks ever so much...

now to see if the end user is happy..no doubt they will change it again!!

Immatoity
10-25-2011, 11:37 AM
dredging this up...is there any way i can get the format from one of the ranges I lookup? the reason being some are in Euros and some are £ on the seperate sheets..would be handy to have that format copied across to the summary..ta

Option Explicit
Sub CreateSummary()
Dim ws As Worksheet, sh As Worksheet
Dim Strt As String, Endd As String, MySum As String
Dim Rw As Long, i As Long
On Error Resume Next
Set ws = Sheets("Summary")
If ws Is Nothing Then Set ws = Sheets.Add(before:=Sheets(1))
ws.Name = "Summary"
Rw = 1
With ws
.Cells(1, 1) = "Sheet Name"
.Cells(1, 2).Resize(, 13) = Array("Site", "Engine No", "Engine Type", "Desc", "Eng Hrs", "Total Batch Price", "Total Unit Price for Month", "Total Spares", "Total Delivery Charges", "Total Hours", "Total Miles", "Total DT Workshop Unit Value", "Order No")
For i = 2 To Sheets.Count
Rw = Rw + 1
Set sh = Sheets(i)
.Cells(Rw, 1) = sh.Name
.Cells(Rw, 2) = sh.Range("A4")
.Cells(Rw, 3) = sh.Range("B4")
.Cells(Rw, 4) = sh.Range("C4")
.Cells(Rw, 5) = sh.Range("d4")
.Cells(Rw, 6) = sh.Range("e4")
.Cells(Rw, 7) = sh.Range("a2")
.Cells(Rw, 8) = sh.Range("f2")
.Cells(Rw, 9) = sh.Range("h2")
.Cells(Rw, 10) = sh.Range("j2")
.Cells(Rw, 11) = sh.Range("k2")
.Cells(Rw, 12) = sh.Range("L2")
.Cells(Rw, 13) = sh.Range("b27")
.Cells(Rw, 14) = sh.Range("g2")

Next
End With
Columns("A:n").EntireColumn.AutoFit
Columns("g:h").NumberFormat = "#,##0.00"
Columns("J:J").NumberFormat = "#,##0.00"
Cells.Find(What:="DOUG", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Selection.EntireRow.Delete

End Sub

mdmackillop
10-25-2011, 02:02 PM
See here (http://www.vbaexpress.com/forum/showthread.php?t=39533)
Just read and assign the required format.

Immatoity
10-25-2011, 02:14 PM
cheers for reply...me being my thick self..

the items when copied/moved to my summary are just numbers, but in "original" sheets they are £ or Euro formatted.. I need that format copied across too?