Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help to modify code
Hi all, i have the code below (Compliments Peter T) that is doing what i
want it to. On hindsight i do not need to show the month with every list, but just the total. How would i modify the code to show just the total and not the month ??? Sub test() Dim arrTotals(1 To 12, 1 To 2) As Double Dim arr, i As Integer, m As Variant With Range("G6") arr = .Resize(.End(xlDown).Row - .Row + 1, 2) End With For i = 1 To UBound(arr) m = Month(arr(i, 1)) arrTotals(m, 2) = arrTotals(m, 2) + arr(i, 2) Next For i = 1 To 12 arrTotals(i, 1) = i Next Range("O1:P12").Value = arrTotals<-Inserts month and total End Sub Best regards, Les Stout *** Sent via Developersdex http://www.developersdex.com *** |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help to modify code
i really can't see what's supposed to be happening, but i'll throw this out. i'm
sure there's a better way replace Range("O1:P12").Value = arrTotals with For i = LBound(arrTotals) To UBound(arrTotals) Range("P" & i).Value = arrTotals(i, 2) Next -- Gary "Les Stout" wrote in message ... Hi all, i have the code below (Compliments Peter T) that is doing what i want it to. On hindsight i do not need to show the month with every list, but just the total. How would i modify the code to show just the total and not the month ??? Sub test() Dim arrTotals(1 To 12, 1 To 2) As Double Dim arr, i As Integer, m As Variant With Range("G6") arr = .Resize(.End(xlDown).Row - .Row + 1, 2) End With For i = 1 To UBound(arr) m = Month(arr(i, 1)) arrTotals(m, 2) = arrTotals(m, 2) + arr(i, 2) Next For i = 1 To 12 arrTotals(i, 1) = i Next Range("O1:P12").Value = arrTotals<-Inserts month and total End Sub Best regards, Les Stout *** Sent via Developersdex http://www.developersdex.com *** |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help to modify code
Thanks Gary, if i put that in a loop, is it possible to reset the
arrTotal, as it is working but totalling accumalative ?? Best regards, Les Stout *** Sent via Developersdex http://www.developersdex.com *** |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help to modify code
i don't see how the data is laid out, so i can't make any suggestions. maybe
someone else can figure out what's going on, or else post where data is located, what it is and where you want totals and then i may be able to help. sorry -- Gary "Les Stout" wrote in message ... Thanks Gary, if i put that in a loop, is it possible to reset the arrTotal, as it is working but totalling accumalative ?? Best regards, Les Stout *** Sent via Developersdex http://www.developersdex.com *** |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help to modify code
Hi Gary, here is my monstrosoty !! I have combined some of Ron de Bruins
code and the other code. What it does is opens all files in a folder and counts the values for a month and then saves the total with the file name as the header. With the totals per month under neath it. Sub GetTotalsA() Dim myPath As String, sMonth As Variant, sCont As String Dim myFiles() As String, sPart As String, Fnum As Long, newBook As String Dim mybook As Workbook Dim CalcMode As Long, col As Long, lRow As Long Dim sh As Worksheet Dim ErrorYes As Boolean, blnPath As Boolean, FolderExists As Boolean Dim arrTotals(1 To 12, 1 To 2) As Variant, i As Integer, m As Integer Dim arr, dt1 As Date, arrMonths As String, FolderName As String Dim last As Long arrMonths = ("Jan, Feb, Mar, Apr,May, June") sMonth = InputBox("Please enter the month to process as per the folder name...", "MONTH TO PROCESS") myPath = "\\nv09001\za-t-m-2$\Department\T-M-20\Marieta\EngChanges\" & sMonth FolderExists = (Dir(myPath, vbDirectory + vbHidden) < vbNullString) If FolderExists = False Then MsgBox "Invalid Folder name, re-enter..." GetFiles End If '------------------------------------------------------- Workbooks.Add '------------------------------------------------------- 'Fill in the path\folder where the files are myPath = "\\nv09001\za-t-m-2$\Department\T-M-20\Marieta\EngChanges\" & sMonth ActiveWorkbook.SaveAs (myPath & "_Totals.xls") newBook = ActiveWorkbook.Name 'Add a slash at the end if the user forget it If Right(myPath, 1) < "\" Then myPath = myPath & "\" End If 'NewNumber: ' sPart = InputBox("PLease enter the part number to summarise...", "PART NUMBER") ' If Not IsNumeric(sPart) Then ' MsgBox "Your entry is not all numeric" ' GoTo NewNumber ' End If ' If Len(sPart) < 7 Then ' MsgBox "Part Number must be 7 numbers" ' GoTo NewNumber ' End If 'If there are no Excel files in the folder exit the sub FilesInPath = Dir(myPath & sPart & "*.xls") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If 'Fill the array(myFiles)with the list of Excel files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve myFiles(1 To Fnum) myFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With lRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(myFiles) To UBound(myFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(myPath & myFiles(Fnum)) On Error GoTo 0 If Not mybook Is Nothing Then 'Change cell value(s) in one worksheet in mybook On Error Resume Next With mybook.Worksheets(1) If .ProtectContents = False Then col = col + 1 Range("G1:G5") = "Date" Columns("G:G").TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, Tab:=True, FieldInfo:=Array(1, 4), _ TrailingMinusNumbers:=True With Range("G6") arr = .Resize(.End(xlDown).Row - .Row + 1, 2) End With For i = 1 To UBound(arr) m = Month(arr(i, 1)) arrTotals(m, 2) = arrTotals(m, 2) + arr(i, 2) Next For i = 1 To 12 arrTotals(i, 1) = Format(DateSerial(7, i, 20), "mmm") Next '----- Workbooks(newBook).Activate '----- ' Cells(lRow, col).Resize(6, 1) = arrMonths Cells(lRow, col) = Left(myFiles(Fnum), Len(myFiles(Fnum)) - 4) For i = LBound(arrTotals) To UBound(arrTotals) Range("P" & i).Value = arrTotals(i, 2) arrTotals(1, 2) = 0 Next ActiveSheet.Cells(lRow + 1, col).Resize(12, 2).Value = arrTotals Workbooks(myFiles(Fnum)).Close savechanges:=False col = col + 2 '<--- Must change to 1 if no months If col = 100 Then lRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 2 col = 0 ' Cells(lRow, col) = Left(myFiles(Fnum), Len(myFiles(Fnum)) - 4) End If Else ErrorYes = True End If End With If Err.Number 0 Then ErrorYes = True Err.Clear 'Close mybook without saving mybook.Close savechanges:=False Else 'Save and close mybook mybook.Close savechanges:=True End If On Error GoTo 0 Else 'Not possible to open the workbook ErrorYes = True End If Next Fnum End If If ErrorYes = True Then MsgBox "There are problems in one or more files, possible problem:" _ & vbNewLine & "protected workbook/sheet or a sheet/range that not exist" End If 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With sCont = MsgBox("Process another number ?", vbYesNo, "CONTINUE ?") If sCont = vbYes Then ' GoTo NewNumber End If ColourAltLinesA End Sub Best regards, Les Stout *** Sent via Developersdex http://www.developersdex.com *** |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help to modify code
Hello again,
I think it would be virtually impossible for anyone to understand your requirements without viewing the original thread where this all came from - Subject: Total up values for one month Date:1 Aug 07 Use separate arrays for totals and if required month names, eg Sub test2() Dim arrTotals(1 To 12, 1 To 1) As Double Dim arrMonths(1 To 12, 1 To 1) As Long Dim arrMonthsNames(1 To 12, 1 To 1) As String Dim arr Dim i As Long, m As Long With Range("G6") ' top of dates column, values to right arr = .Resize(.End(xlDown).Row - .Row + 1, 2) End With For i = 1 To UBound(arr) m = Month(arr(i, 1)) arrTotals(m, 1) = arrTotals(m, 1) + arr(i, 2) Next Range("P1:P12").Value = arrTotals ' Month numbers next to totals if required For i = 1 To 12 arrMonths(i, 1) = i Next Range("O1:O12").Value = arrMonths ' or Months spelt out 'For i = 1 To 12 'arrMonthsNames(i, 1) = Format(DateSerial(7, i, 20), "mmm") 'Next 'Range("O1:O12").Value = arrMonthsNames End Sub Regards, Peter T "Les Stout" wrote in message ... Hi all, i have the code below (Compliments Peter T) that is doing what i want it to. On hindsight i do not need to show the month with every list, but just the total. How would i modify the code to show just the total and not the month ??? Sub test() Dim arrTotals(1 To 12, 1 To 2) As Double Dim arr, i As Integer, m As Variant With Range("G6") arr = .Resize(.End(xlDown).Row - .Row + 1, 2) End With For i = 1 To UBound(arr) m = Month(arr(i, 1)) arrTotals(m, 2) = arrTotals(m, 2) + arr(i, 2) Next For i = 1 To 12 arrTotals(i, 1) = i Next Range("O1:P12").Value = arrTotals<-Inserts month and total End Sub Best regards, Les Stout *** Sent via Developersdex http://www.developersdex.com *** |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help to modify code
Hi Peter, thank you for your reply... I am trying to include it into Ron
de Bruin's code so that i can loop through a folder and open each file, get the results then paste it into a new workbook offset then next result with the actual file name as a header. It is working but the Totals are accumilating ?? Best regards, Les Stout *** Sent via Developersdex http://www.developersdex.com *** |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help to modify code
It is working but the Totals are accumilating ??
Do you mean the in example I posted values are being added more than once, surely not. If that's not what you mean I'm afraid I haven't a clue what you are talking about. Regards, Peter T "Les Stout" wrote in message ... Hi Peter, thank you for your reply... I am trying to include it into Ron de Bruin's code so that i can loop through a folder and open each file, get the results then paste it into a new workbook offset then next result with the actual file name as a header. It is working but the Totals are accumilating ?? Best regards, Les Stout *** Sent via Developersdex http://www.developersdex.com *** |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Modify code | Excel Discussion (Misc queries) | |||
Modify Code | Excel Worksheet Functions | |||
almost there ... code modify help | Excel Programming | |||
Modify code in UDF | Excel Programming | |||
How to modify VBA code for Add-in? | Excel Programming |