Code Modifications
I use the code below to populate the Monthly Summary log using a combo box
that the user selects a date. In my source sheet (Daily Reading Master Log) I have added a new row for column headings and removed column A. Problem: How do I adjust this code to account for the changes, so that code runs and the fields populate on teh Monthly Summary? Public Function CreateMonthlyReport() As Boolean Application.ScreenUpdating = False Dim saveCalcMode ' remember initial calc mode saveCalcMode = Application.Calculation Application.Calculation = xlCalculationManual 'created as a function so it doesn't appear in the list of available Macros 'called by the _AfterUpdate event on the ComboBox on the MonthlySummary sheet 'chosen month is in cell AK on the Monthly Summary sheet Dim whatMonth As Integer Dim whatDay As Integer ' will be used as a loop counter also Dim sourceLastDataRow As Long Dim sourceRowLC As Long ' loop counter Dim tempLC As Integer ' working, general purpose loop counter Dim sourceDataColOffset As Integer Dim destRowOffset As Long Dim tot As Integer Const sourceSheet = "Daily Reading Master Log" ' referred to in comments as DRML sheet Const destSheet = "Monthly Summary" Const destBaseCell = "B1" 'upper left corner of the sheets data area 'all locations will be relative to this address Const sourceBaseCell = "A1" ' upper left on DRML sheet Const maxDay = 31 ' use 31 even for short months so that unused days get zeroed out. Const dropDownLinkCell = "AL1" Const monthEchoCell = "B4" Application.EnableEvents = False ' in case they try to change month! 'find out what month we are interested in 'convert to integer: 1 = January ... 12 = December Select Case Trim(UCase(Worksheets(destSheet).Range(dropDownLin kCell))) Case Is = "JANUARY" whatMonth = 1 Case Is = "FEBRUARY" whatMonth = 2 Case Is = "MARCH" whatMonth = 3 Case Is = "APRIL" whatMonth = 4 Case Is = "MAY" whatMonth = 5 Case Is = "JUNE" whatMonth = 6 Case Is = "JULY" whatMonth = 7 Case Is = "AUGUST" whatMonth = 8 Case Is = "SEPTEMBER" whatMonth = 9 Case Is = "OCTOBER" whatMonth = 10 Case Is = "NOVEMBER" whatMonth = 11 Case Is = "DECEMBER" whatMonth = 12 Case Else Application.EnableEvents = True Exit Function ' quit, it was empty End Select Range(monthEchoCell).Select ActiveCell.Value = Range(dropDownLinkCell) Range(dropDownLinkCell) = "" ' so if they choose same month again, it will work again 'determine last row with a date in it on DRML sheet sourceLastDataRow = Worksheets(sourceSheet).Range("A" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False ' speed things up, no window flickering either For whatDay = 1 To maxDay ' start with 1st day of the month 'clear out the current entries 'have to work hard at this because of merged cells 'Production For tempLC = 6 To 13 Worksheets(destSheet).Range(destBaseCell).Offset(t empLC, whatDay) = "" Next 'Concentrate For tempLC = 17 To 20 Worksheets(destSheet).Range(destBaseCell).Offset(t empLC, whatDay) = "" Next 'Treatment Results For tempLC = 22 To 30 Worksheets(destSheet).Range(destBaseCell).Offset(t empLC, whatDay) = "" Next 'Reagents For tempLC = 31 To 34 Worksheets(destSheet).Range(destBaseCell).Offset(t empLC, whatDay) = "" Next 'Safety For tempLC = 35 To 40 Worksheets(destSheet).Range(destBaseCell).Offset(t empLC, whatDay) = "" Next 'Environment For tempLC = 41 To 44 Worksheets(destSheet).Range(destBaseCell).Offset(t empLC, whatDay) = "" Next 'now match month and day to entries in the DRML sheet For sourceRowLC = 2 To sourceLastDataRow - 1 ' use as offset If Day(Worksheets(sourceSheet).Range(sourceBaseCell). Offset(sourceRowLC, 1)) = whatDay And _ Month(Worksheets(sourceSheet).Range(sourceBaseCell ).Offset(sourceRowLC, 1)) = whatMonth Then 'month and day match!! 'move the data, item by item 'each of these is pretty much the same operation 'only the offset to the column with the data 'on the DRML sheet changes during each step ' we'll use a declared variable to set that up ' so if maintenance is needed, it can be done ' with less risk of messing up formulas 'PRODUCTION 'Production: Operating Hours destRowOffset = 6 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("AD1").Column - 1 ' column F Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Production: Discharge Hours destRowOffset = 7 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("AE1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Production: Plant Availability % destRowOffset = 8 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("AO1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Production: Total Availability % destRowOffset = 9 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("AP1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Production: Water Feed Flow, m3 destRowOffset = 10 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("AJ1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Production: Average Water Feed Flow (total water flow) destRowOffset = 11 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("AK1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Production: Water Discharge ( total discharge flow) destRowOffset = 12 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("AL1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Production: Average Water Discharge destRowOffset = 13 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("AM1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'CONCENTRATE 'Concentrate: Concentrate Shipped (Product Removed) destRowOffset = 17 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("BB1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Concentrate: Concentrate Density, % destRowOffset = 18 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("AY1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Concentrate: Concentrate Grade Ni % (% Ni Content) destRowOffset = 19 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("BA1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Concentrate: Nickel Shipped, kg (Nickel Removed) destRowOffset = 20 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("BE1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'TREATMENT RESULTS 'treatment Results: Feed Grade (Calculated Feed Nickel from LAB) destRowOffset = 22 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("DA1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'treatment Results: Treated Water Lab, Ni (Calculated Effluent Nickel from LAB) destRowOffset = 23 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("DB1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'treatment Results: Treated Water Dissolved Ni LAB (Calculated Dissolved Feed Nickel from LAB) destRowOffset = 24 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("DC1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'treatment Results: Treated Water Ni, HACH (Calculated Effluent Nickel from HACH) destRowOffset = 25 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("DE1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'treatment Results: Nickel Recovery, % destRowOffset = 26 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("DI1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'treatment Results: Nickel Recovered, kg destRowOffset = 27 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("DJ1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'REAGENTS 'Reagents: NaHS, kg (NAHS Used) destRowOffset = 29 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("DR1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Reagents: Sodium Bicarbonate, kg (Sodium Bicarbonate Used) destRowOffset = 30 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("DY1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Reagents: Aluminex Consumed destRowOffset = 31 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("FI1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Reagents: Floc, kg destRowOffset = 32 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("EH1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'SAFETY 'Safety: Manhours destRowOffset = 34 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("AB1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Safety: Incident Reports destRowOffset = 35 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("P1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Safety: Lost Time Hours destRowOffset = 36 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("O1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'ENVIRONMENT 'Daphina Magna Toxicity Results destRowOffset = 39 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("Q1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Rainbow Trout destRowOffset = 40 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("R1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Effluent pH destRowOffset = 41 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("DD1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) 'Effluent TSS destRowOffset = 42 'row number data item is on minus 1 'just enter address of appropriate column using Row 1 to get proper column offset sourceDataColOffset = Range("BX1").Column - 1 Worksheets(destSheet).Range(destBaseCell).Offset(d estRowOffset, whatDay) = _ Worksheets(sourceSheet).Range(sourceBaseCell).Offs et(sourceRowLC, sourceDataColOffset) End If End If Next ' sourceRowLC loop end Next ' whatDay loop end ' restore initial calc mode Application.Calculation = saveCalcMode Application.EnableEvents = True Application.ScreenUpdating = True ' ActiveSheet.Protect End Function -- Carlee |
All times are GMT +1. The time now is 04:15 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com