|
MACRO TO MULTIPLY AMOUNTS WITH PERCENTAGES
Hi all, Please see the link below where i have uploded my Sheet.
http://www.savefile.com/files/1535694 I uploded my file as i don' t think i can explain my question here. i have put my question in above uploaded excel file clearly. Please can any body help as it is very important for my project which i am doing for my job. If any friend can help it will much appricated. |
MACRO TO MULTIPLY AMOUNTS WITH PERCENTAGES
I get the same results you do. Nothing need to be done except run macro.
Macro creates new worksheet "results". If macro is run a 2nd time instead of creating new worksheet it clears the present "results" worksheet. Sub calc_results() 'check if worksheet results exists Found = False For Each sht In Sheets If sht.Name = "Results" Then Found = True Exit For End If Next sht If Found = True Then 'clear worksheet Sheets("Results").Cells.Clear Else Sheets.Add after:=Sheets(Sheets.Count) ActiveSheet.Name = "Results" End If 'copy head row from form to Results With Sheets("Form") .Rows(1).Copy Destination:=Sheets("Results").Rows(1) Sheets("Results").Range("G1") = "PERIOD" FormRowCount = 2 ResultsRowCount = 2 Do While .Range("A" & FormRowCount) < "" For MyMonth = 1 To 12 .Rows(FormRowCount).Copy _ Destination:=Sheets("Results").Rows(ResultsRowCoun t) Period = Val(Format(Date, "YYYY") & Format(MyMonth, "0#")) Code = .Range("D" & FormRowCount) With Sheets("PERCENTAGES DATA") Set PercentRow = .Columns("A").Find(what:=Code, _ LookIn:=xlValues, lookat:=xlWhole) If PercentRow Is Nothing Then MsgBox ("Cannot find Code : " & Code) Exit Sub End If Set PercentCol = .Rows(2).Find(what:=Period, _ LookIn:=xlValues, lookat:=xlWhole) If PercentCol Is Nothing Then MsgBox ("Cannot find Period : " & Period) Exit Sub End If PercentNumber = .Cells(PercentRow.Row, PercentCol.Column) / 100 End With With Sheets("Results") .Range("G" & ResultsRowCount) = Period .Range("E" & ResultsRowCount).Formula = _ "=" & PercentNumber & "*Form!E" & FormRowCount End With ResultsRowCount = ResultsRowCount + 1 Next MyMonth FormRowCount = FormRowCount + 1 Loop End With Sheets("Results").Columns("A:G").Columns.AutoFit End Sub "K" wrote: Hi all, Please see the link below where i have uploded my Sheet. http://www.savefile.com/files/1535694 I uploded my file as i don' t think i can explain my question here. i have put my question in above uploaded excel file clearly. Please can any body help as it is very important for my project which i am doing for my job. If any friend can help it will much appricated. |
MACRO TO MULTIPLY AMOUNTS WITH PERCENTAGES
On 3 May, 07:09, Joel wrote:
I get the same results you do. *Nothing need to be done except run macro.. * Macro creates new worksheet "results". *If macro is run a 2nd time instead of creating new worksheet it clears the present "results" worksheet. Sub calc_results() 'check if worksheet results exists Found = False For Each sht In Sheets * *If sht.Name = "Results" Then * * * Found = True * * * Exit For * *End If Next sht If Found = True Then * *'clear worksheet * *Sheets("Results").Cells.Clear Else * *Sheets.Add after:=Sheets(Sheets.Count) * *ActiveSheet.Name = "Results" End If 'copy head row from form to Results With Sheets("Form") * *.Rows(1).Copy Destination:=Sheets("Results").Rows(1) * *Sheets("Results").Range("G1") = "PERIOD" * *FormRowCount = 2 * *ResultsRowCount = 2 * *Do While .Range("A" & FormRowCount) < "" * * * For MyMonth = 1 To 12 * * * * *.Rows(FormRowCount).Copy _ * * * * * * Destination:=Sheets("Results").Rows(ResultsRowCoun t) * * * * *Period = Val(Format(Date, "YYYY") & Format(MyMonth, "0#")) * * * * *Code = .Range("D" & FormRowCount) * * * * *With Sheets("PERCENTAGES DATA") * * * * * * Set PercentRow = .Columns("A").Find(what:=Code, _ * * * * * * * *LookIn:=xlValues, lookat:=xlWhole) * * * * * * If PercentRow Is Nothing Then * * * * * * * *MsgBox ("Cannot find Code : " & Code) * * * * * * * *Exit Sub * * * * * * End If * * * * * * Set PercentCol = .Rows(2).Find(what:=Period, _ * * * * * * * *LookIn:=xlValues, lookat:=xlWhole) * * * * * * If PercentCol Is Nothing Then * * * * * * * *MsgBox ("Cannot find Period : " & Period) * * * * * * * *Exit Sub * * * * * * End If * * * * * * PercentNumber = .Cells(PercentRow.Row, PercentCol.Column) / 100 * * * * *End With * * * * *With Sheets("Results") * * * * * * .Range("G" & ResultsRowCount) = Period * * * * * * .Range("E" & ResultsRowCount).Formula = _ * * * * * * * *"=" & PercentNumber & "*Form!E" & FormRowCount * * * * *End With * * * * *ResultsRowCount = ResultsRowCount + 1 * * * Next MyMonth * * * FormRowCount = FormRowCount + 1 * *Loop End With Sheets("Results").Columns("A:G").Columns.AutoFit End Sub "K" wrote: Hi all, Please see the link below where i have uploded my Sheet. http://www.savefile.com/files/1535694 I uploded my file as i don' t think i can explain my question here. *i have put my question in above uploaded excel file clearly. *Please can any body help as it is very important for my project which i am doing for my job. If any friend can help it will much appricated.- Hide quoted text - - Show quoted text - Thanks Joel your macro is working superb. Just little request that if you can explain your macro that who its working so i can have better understaning with your macro. thanks |
MACRO TO MULTIPLY AMOUNTS WITH PERCENTAGES
I added more comments to the code. I also made some minor chages to make the
code a little bit more efficient. Sub calc_results() 'check if worksheet results exists Found = False 'Look in every sheet to see if the sheet "Results" exists For Each sht In Sheets If sht.Name = "Results" Then Found = True Exit For End If Next sht If Found = True Then 'clear worksheet Sheets("Results").Cells.Clear Else 'Add new worsheet and name it "Results 'put new sheet as last sheet in workbook Sheets.Add after:=Sheets(Sheets.Count) ActiveSheet.Name = "Results" End If 'read data from Sheet "Form" With Sheets("Form") 'copy header row from "Form" to "Results" .Rows(1).Copy Destination:=Sheets("Results").Rows(1) 'Add Word Period to column G in first row Sheets("Results").Range("G1") = "PERIOD" 'Start Looking for data on Form in row 2, skip header FormRowCount = 2 'Put data in Results sheet in Row 2 after Header ResultsRowCount = 2 'Loop through every row of the form Do While .Range("A" & FormRowCount) < "" 'get the code from the form worksheet in column D Code = .Range("D" & FormRowCount) 'Write results for 12 months on Results Sheet For MyMonth = 1 To 12 'The FOR loop will 'Copy one Row of data from "Form" sheet to "Results" Sheet 'The same row will be copied 12 times to 12 different rows in Results .Rows(FormRowCount).Copy _ Destination:=Sheets("Results").Rows(ResultsRowCoun t) 'Create the period using the current Year and a 2 digit month 'Period is a Number, not a string 'MyMonth is formated to create a two digit number 'Val will convert the two string to a single number Period = Val(Format(Date, "YYYY") & Format(MyMonth, "0#")) With Sheets("PERCENTAGES DATA") 'search for the code in Column A of the Percentage Data sheet Set PercentRow = .Columns("A").Find(what:=Code, _ LookIn:=xlValues, lookat:=xlWhole) 'Display Error message if code is not found If PercentRow Is Nothing Then MsgBox ("Cannot find Code : " & Code) Exit Sub End If 'search for Period in Row 2 of the Percentage Data sheet Set PercentCol = .Rows(2).Find(what:=Period, _ LookIn:=xlValues, lookat:=xlWhole) 'display error message if Period is not found If PercentCol Is Nothing Then MsgBox ("Cannot find Period : " & Period) Exit Sub End If 'get Percentage Number from the Percentage Data sheet 'convert percentage to fraction by dividing by 100 PercentNumber = .Cells(PercentRow.Row, PercentCol.Column) / 100 End With With Sheets("Results") 'Write the Period in Column G in the Results sheet .Range("G" & ResultsRowCount) = Period 'Add a formula to column E of the Results sheet that multiplies 'the Percentage number with the Amount in Form sheet .Range("E" & ResultsRowCount).Formula = _ "=" & PercentNumber & "*Form!E" & FormRowCount End With 'Increment the results row for each of the 12 months ResultsRowCount = ResultsRowCount + 1 Next MyMonth 'get the Next Row of data from the Form sheet FormRowCount = FormRowCount + 1 Loop End With 'format the Results sheet 'Autofit all the columns Sheets("Results").Columns("A:G").Columns.AutoFit End Sub "K" wrote: On 3 May, 07:09, Joel wrote: I get the same results you do. Nothing need to be done except run macro.. Macro creates new worksheet "results". If macro is run a 2nd time instead of creating new worksheet it clears the present "results" worksheet. Sub calc_results() 'check if worksheet results exists Found = False For Each sht In Sheets If sht.Name = "Results" Then Found = True Exit For End If Next sht If Found = True Then 'clear worksheet Sheets("Results").Cells.Clear Else Sheets.Add after:=Sheets(Sheets.Count) ActiveSheet.Name = "Results" End If 'copy head row from form to Results With Sheets("Form") .Rows(1).Copy Destination:=Sheets("Results").Rows(1) Sheets("Results").Range("G1") = "PERIOD" FormRowCount = 2 ResultsRowCount = 2 Do While .Range("A" & FormRowCount) < "" For MyMonth = 1 To 12 .Rows(FormRowCount).Copy _ Destination:=Sheets("Results").Rows(ResultsRowCoun t) Period = Val(Format(Date, "YYYY") & Format(MyMonth, "0#")) Code = .Range("D" & FormRowCount) With Sheets("PERCENTAGES DATA") Set PercentRow = .Columns("A").Find(what:=Code, _ LookIn:=xlValues, lookat:=xlWhole) If PercentRow Is Nothing Then MsgBox ("Cannot find Code : " & Code) Exit Sub End If Set PercentCol = .Rows(2).Find(what:=Period, _ LookIn:=xlValues, lookat:=xlWhole) If PercentCol Is Nothing Then MsgBox ("Cannot find Period : " & Period) Exit Sub End If PercentNumber = .Cells(PercentRow.Row, PercentCol.Column) / 100 End With With Sheets("Results") .Range("G" & ResultsRowCount) = Period .Range("E" & ResultsRowCount).Formula = _ "=" & PercentNumber & "*Form!E" & FormRowCount End With ResultsRowCount = ResultsRowCount + 1 Next MyMonth FormRowCount = FormRowCount + 1 Loop End With Sheets("Results").Columns("A:G").Columns.AutoFit End Sub "K" wrote: Hi all, Please see the link below where i have uploded my Sheet. http://www.savefile.com/files/1535694 I uploded my file as i don' t think i can explain my question here. i have put my question in above uploaded excel file clearly. Please can any body help as it is very important for my project which i am doing for my job. If any friend can help it will much appricated.- Hide quoted text - - Show quoted text - Thanks Joel your macro is working superb. Just little request that if you can explain your macro that who its working so i can have better understaning with your macro. thanks |
MACRO TO MULTIPLY AMOUNTS WITH PERCENTAGES
On 3 May, 18:40, Joel wrote:
I added more comments to the code. *I also made some minor chages to make the code a little bit more efficient. Sub calc_results() 'check if worksheet results exists Found = False 'Look in every sheet to see if the sheet "Results" exists For Each sht In Sheets * *If sht.Name = "Results" Then * * * Found = True * * * Exit For * *End If Next sht If Found = True Then * *'clear worksheet * *Sheets("Results").Cells.Clear Else * *'Add new worsheet and name it "Results * *'put new sheet as last sheet in workbook * *Sheets.Add after:=Sheets(Sheets.Count) * *ActiveSheet.Name = "Results" End If 'read data from Sheet "Form" With Sheets("Form") * *'copy header row from "Form" to "Results" * *.Rows(1).Copy Destination:=Sheets("Results").Rows(1) * *'Add Word Period to column G in first row * *Sheets("Results").Range("G1") = "PERIOD" * *'Start Looking for data on Form in row 2, skip header * *FormRowCount = 2 * *'Put data in Results sheet in Row 2 after Header * *ResultsRowCount = 2 * *'Loop through every row of the form * *Do While .Range("A" & FormRowCount) < "" * * * 'get the code from the form worksheet in column D * * * Code = .Range("D" & FormRowCount) * * * 'Write results for 12 months on Results Sheet * * * For MyMonth = 1 To 12 * * * * *'The FOR loop will * * * * * * 'Copy one Row of data from "Form" sheet to "Results" Sheet * * * * * * 'The same row will be copied 12 times to 12 different rows in Results * * * * *.Rows(FormRowCount).Copy _ * * * * * * Destination:=Sheets("Results").Rows(ResultsRowCoun t) * * * * *'Create the period using the current Year and a 2 digit month * * * * *'Period is a Number, not a string * * * * *'MyMonth is formated to create a two digit number * * * * *'Val will convert the two string to a single number * * * * *Period = Val(Format(Date, "YYYY") & Format(MyMonth, "0#")) * * * * *With Sheets("PERCENTAGES DATA") * * * * * * 'search for the code in Column A of the Percentage Data sheet * * * * * * Set PercentRow = .Columns("A").Find(what:=Code, _ * * * * * * * *LookIn:=xlValues, lookat:=xlWhole) * * * * * * 'Display Error message if code is not found * * * * * * If PercentRow Is Nothing Then * * * * * * * *MsgBox ("Cannot find Code : " & Code) * * * * * * * *Exit Sub * * * * * * End If * * * * * * 'search for Period in Row 2 of the Percentage Data sheet * * * * * * Set PercentCol = .Rows(2).Find(what:=Period, _ * * * * * * * *LookIn:=xlValues, lookat:=xlWhole) * * * * * * 'display error message if Period is not found * * * * * * If PercentCol Is Nothing Then * * * * * * * *MsgBox ("Cannot find Period : " & Period) * * * * * * * *Exit Sub * * * * * * End If * * * * * * 'get Percentage Number from the Percentage Data sheet * * * * * * 'convert percentage to fraction by dividing by 100 * * * * * * PercentNumber = .Cells(PercentRow.Row, PercentCol.Column) / 100 * * * * *End With * * * * *With Sheets("Results") * * * * * * 'Write the Period in Column G in the Results sheet * * * * * * .Range("G" & ResultsRowCount) = Period * * * * * * 'Add a formula to column E of the Results sheet that multiplies * * * * * * 'the Percentage number with the Amount in Form sheet * * * * * * .Range("E" & ResultsRowCount).Formula = _ * * * * * * * *"=" & PercentNumber & "*Form!E" & FormRowCount * * * * *End With * * * * *'Increment the results row for each of the 12 months * * * * *ResultsRowCount = ResultsRowCount + 1 * * * Next MyMonth * * * 'get the Next Row of data from the Form sheet * * * FormRowCount = FormRowCount + 1 * *Loop End With 'format the Results sheet 'Autofit all the columns Sheets("Results").Columns("A:G").Columns.AutoFit End Sub "K" wrote: On 3 May, 07:09, Joel wrote: I get the same results you do. *Nothing need to be done except run macro.. * Macro creates new worksheet "results". *If macro is run a 2nd time instead of creating new worksheet it clears the present "results" worksheet. Sub calc_results() 'check if worksheet results exists Found = False For Each sht In Sheets * *If sht.Name = "Results" Then * * * Found = True * * * Exit For * *End If Next sht If Found = True Then * *'clear worksheet * *Sheets("Results").Cells.Clear Else * *Sheets.Add after:=Sheets(Sheets.Count) * *ActiveSheet.Name = "Results" End If 'copy head row from form to Results With Sheets("Form") * *.Rows(1).Copy Destination:=Sheets("Results").Rows(1) * *Sheets("Results").Range("G1") = "PERIOD" * *FormRowCount = 2 * *ResultsRowCount = 2 * *Do While .Range("A" & FormRowCount) < "" * * * For MyMonth = 1 To 12 * * * * *.Rows(FormRowCount).Copy _ * * * * * * Destination:=Sheets("Results").Rows(ResultsRowCoun t) * * * * *Period = Val(Format(Date, "YYYY") & Format(MyMonth, "0#")) * * * * *Code = .Range("D" & FormRowCount) * * * * *With Sheets("PERCENTAGES DATA") * * * * * * Set PercentRow = .Columns("A").Find(what:=Code, _ * * * * * * * *LookIn:=xlValues, lookat:=xlWhole) * * * * * * If PercentRow Is Nothing Then * * * * * * * *MsgBox ("Cannot find Code : " & Code) * * * * * * * *Exit Sub * * * * * * End If * * * * * * Set PercentCol = .Rows(2).Find(what:=Period, _ * * * * * * * *LookIn:=xlValues, lookat:=xlWhole) * * * * * * If PercentCol Is Nothing Then * * * * * * * *MsgBox ("Cannot find Period : " & Period) * * * * * * * *Exit Sub * * * * * * End If * * * * * * PercentNumber = .Cells(PercentRow.Row, PercentCol.Column) / 100 * * * * *End With * * * * *With Sheets("Results") * * * * * * .Range("G" & ResultsRowCount) = Period * * * * * * .Range("E" & ResultsRowCount).Formula = _ * * * * * * * *"=" & PercentNumber & "*Form!E" & FormRowCount * * * * *End With * * * * *ResultsRowCount = ResultsRowCount + 1 * * * Next MyMonth * * * FormRowCount = FormRowCount + 1 * *Loop End With Sheets("Results").Columns("A:G").Columns.AutoFit End Sub "K" wrote: Hi all, Please see the link below where i have uploded my Sheet. http://www.savefile.com/files/1535694 I uploded my file as i don' t think i can explain my question here. *i have put my question in above uploaded excel file clearly. *Please can any body help as it is very important for my project which i am doing for my job. If any friend can help it will much appricated.- Hide quoted text - - Show quoted text - Thanks Joel your macro is working superb. *Just little request that if you can explain your macro that who its working so *i can have better understaning with your macro. *thanks- Hide quoted text - - Show quoted text - Thanks lot Joel it explain a lot. I am using your code and its working superb. just another question i have another code whcih does the smilar job like the macro you gave me but it not gives the msgbox to tell which code or period is not found. Can you please help me in this that what and where i put the code line in macro below so it also give message box that if any code or period not found and then Exit Sub. Please see the macro below (you can put this code in the sheet so you can better understand the function - http://www.savefile.com/files/1535694 ) Sub MultAmt() Const x = 12 Dim i As Integer Dim LRow As Long Dim rng As Range, c As Range Dim rng2 As Range, c2 As Range LRow = Sheets("FORM").Cells(Rows.Count, "A").End(xlUp).Row Set rng = Sheets("FORM").Range("D2:D" & LRow) LRow = Sheets("RESULT BY MACRO").Cells(Rows.Count, "A").End(xlUp).Row If LRow = 1 Then 'do nothing Else Sheets("RESULT BY MACRO").Rows("2:" & LRow).Delete End If i = 1 For Each c In rng LRow = Sheets("RESULT BY MACRO").Cells(Rows.Count, "A").End(xlUp).Row c.EntireRow.Copy Sheets("RESULT BY MACRO").Range("A" & LRow + i & ":A" & LRow + x) Next LRow = Sheets("RESULT BY MACRO").Cells(Rows.Count, "A").End(xlUp).Row Set rng = Sheets("RESULT BY MACRO").Range("D2:D" & LRow) LRow = Sheets("PERCENTAGES DATA").Cells(Rows.Count, "A").End(xlUp).Row Set rng2 = Sheets("PERCENTAGES DATA").Range("A3:M" & LRow) i = 2 For Each c In rng c.Offset(, 1).Value = c.Offset(, 1).Value * _ (Application.WorksheetFunction.VLookup(c.Value, rng2, i, False) / 100) c.Offset(, 3).Value = Sheet1.Cells(2, i).Value If i = 13 Then i = 2 Else i = i + 1 End If Next End Sub |
MACRO TO MULTIPLY AMOUNTS WITH PERCENTAGES
If yoiu are so concerned about properly documenting your code you should also
use variables that have MEANING. What are c1 and c2 used for??? compare my code with your code and look at which code is easier to understand. Well writeen code has the following 1) Plenty of whitespaces to make it easy to read 2) break complex statements into multiple statements. 3) Use variables theat have meaning. I had two teaches in college who taught programming. They were Son-of-a-Bitch. the same BITCH. They were actually brothers. One taught PASCAL and Fortran and graded based on the amount of comments you had in your code. the second taught assembly language. He was tougher. He took point off for too little comments and too much comments. It had to be just right. He also took off point if you had to many lines of code or too little (if using tricks to reduce lines made the code confusing). I only got B's in his course because I used 12 lines of code where he did it in 11 lines. Sub MultAmt() Const x = 12 Dim i As Integer Dim LRow As Long Dim rng As Range, search_code As Range Dim rng2 As Range, c2 As Range LRow = Sheets("FORM").Cells(Rows.Count, "A").End(xlUp).Row Set codes = Sheets("FORM").Range("D2:D" & LRow) LRow = Sheets("RESULT BY MACRO").Cells(Rows.Count, "A").End(xlUp).Row If LRow = 1 Then 'do nothing Else Sheets("RESULT BY MACRO").Rows("2:" & LRow).Delete End If i = 1 For Each search_code In codes LRow = Sheets("RESULT BY MACRO").Cells(Rows.Count, "A").End(xlUp).Row search_code.EntireRow.Copy Sheets("RESULT BY MACRO").Range("A" & LRow + i & ":A" & LRow + x) Next LRow = Sheets("RESULT BY MACRO").Cells(Rows.Count, "A").End(xlUp).Row Set rng = Sheets("RESULT BY MACRO").Range("D2:D" & LRow) LRow = Sheets("PERCENTAGES DATA").Cells(Rows.Count, "A").End(xlUp).Row 'change range to column A only Set code_range = Sheets("PERCENTAGES DATA").Range("A3:A" & LRow) i = 2 For Each c In rng set mode_cell = code_range.find(what:=c.value, _ lookin:=xlvalues,lookat:=xlwhole) if mode_cell is nothing then msgbox("Cannot find Code : " & c.value) exit sub else Percentage = mode_cell.offset(0,1)/100 end if c.Offset(, 1).Value = c.Offset(, 1).Value * Percentage c.Offset(, 3).Value = Sheet1.Cells(2, i).Value If i = 13 Then i = 2 Else i = i + 1 End If Next End Sub "K" wrote: On 3 May, 18:40, Joel wrote: I added more comments to the code. I also made some minor chages to make the code a little bit more efficient. Sub calc_results() 'check if worksheet results exists Found = False 'Look in every sheet to see if the sheet "Results" exists For Each sht In Sheets If sht.Name = "Results" Then Found = True Exit For End If Next sht If Found = True Then 'clear worksheet Sheets("Results").Cells.Clear Else 'Add new worsheet and name it "Results 'put new sheet as last sheet in workbook Sheets.Add after:=Sheets(Sheets.Count) ActiveSheet.Name = "Results" End If 'read data from Sheet "Form" With Sheets("Form") 'copy header row from "Form" to "Results" .Rows(1).Copy Destination:=Sheets("Results").Rows(1) 'Add Word Period to column G in first row Sheets("Results").Range("G1") = "PERIOD" 'Start Looking for data on Form in row 2, skip header FormRowCount = 2 'Put data in Results sheet in Row 2 after Header ResultsRowCount = 2 'Loop through every row of the form Do While .Range("A" & FormRowCount) < "" 'get the code from the form worksheet in column D Code = .Range("D" & FormRowCount) 'Write results for 12 months on Results Sheet For MyMonth = 1 To 12 'The FOR loop will 'Copy one Row of data from "Form" sheet to "Results" Sheet 'The same row will be copied 12 times to 12 different rows in Results .Rows(FormRowCount).Copy _ Destination:=Sheets("Results").Rows(ResultsRowCoun t) 'Create the period using the current Year and a 2 digit month 'Period is a Number, not a string 'MyMonth is formated to create a two digit number 'Val will convert the two string to a single number Period = Val(Format(Date, "YYYY") & Format(MyMonth, "0#")) With Sheets("PERCENTAGES DATA") 'search for the code in Column A of the Percentage Data sheet Set PercentRow = .Columns("A").Find(what:=Code, _ LookIn:=xlValues, lookat:=xlWhole) 'Display Error message if code is not found If PercentRow Is Nothing Then MsgBox ("Cannot find Code : " & Code) Exit Sub End If 'search for Period in Row 2 of the Percentage Data sheet Set PercentCol = .Rows(2).Find(what:=Period, _ LookIn:=xlValues, lookat:=xlWhole) 'display error message if Period is not found If PercentCol Is Nothing Then MsgBox ("Cannot find Period : " & Period) Exit Sub End If 'get Percentage Number from the Percentage Data sheet 'convert percentage to fraction by dividing by 100 PercentNumber = .Cells(PercentRow.Row, PercentCol.Column) / 100 End With With Sheets("Results") 'Write the Period in Column G in the Results sheet .Range("G" & ResultsRowCount) = Period 'Add a formula to column E of the Results sheet that multiplies 'the Percentage number with the Amount in Form sheet .Range("E" & ResultsRowCount).Formula = _ "=" & PercentNumber & "*Form!E" & FormRowCount End With 'Increment the results row for each of the 12 months ResultsRowCount = ResultsRowCount + 1 Next MyMonth 'get the Next Row of data from the Form sheet FormRowCount = FormRowCount + 1 Loop End With 'format the Results sheet 'Autofit all the columns Sheets("Results").Columns("A:G").Columns.AutoFit End Sub "K" wrote: On 3 May, 07:09, Joel wrote: I get the same results you do. Nothing need to be done except run macro.. Macro creates new worksheet "results". If macro is run a 2nd time instead of creating new worksheet it clears the present "results" worksheet. Sub calc_results() 'check if worksheet results exists Found = False For Each sht In Sheets If sht.Name = "Results" Then Found = True Exit For End If Next sht If Found = True Then 'clear worksheet Sheets("Results").Cells.Clear Else Sheets.Add after:=Sheets(Sheets.Count) ActiveSheet.Name = "Results" End If 'copy head row from form to Results With Sheets("Form") .Rows(1).Copy Destination:=Sheets("Results").Rows(1) Sheets("Results").Range("G1") = "PERIOD" FormRowCount = 2 ResultsRowCount = 2 Do While .Range("A" & FormRowCount) < "" For MyMonth = 1 To 12 .Rows(FormRowCount).Copy _ Destination:=Sheets("Results").Rows(ResultsRowCoun t) Period = Val(Format(Date, "YYYY") & Format(MyMonth, "0#")) Code = .Range("D" & FormRowCount) With Sheets("PERCENTAGES DATA") Set PercentRow = .Columns("A").Find(what:=Code, _ LookIn:=xlValues, lookat:=xlWhole) If PercentRow Is Nothing Then MsgBox ("Cannot find Code : " & Code) Exit Sub End If Set PercentCol = .Rows(2).Find(what:=Period, _ LookIn:=xlValues, lookat:=xlWhole) If PercentCol Is Nothing Then MsgBox ("Cannot find Period : " & Period) Exit Sub End If PercentNumber = .Cells(PercentRow.Row, PercentCol.Column) / 100 End With With Sheets("Results") .Range("G" & ResultsRowCount) = Period .Range("E" & ResultsRowCount).Formula = _ "=" & PercentNumber & "*Form!E" & FormRowCount End With ResultsRowCount = ResultsRowCount + 1 Next MyMonth FormRowCount = FormRowCount + 1 Loop End With Sheets("Results").Columns("A:G").Columns.AutoFit End Sub "K" wrote: Hi all, Please see the link below where i have uploded my Sheet. http://www.savefile.com/files/1535694 I uploded my file as i don' t think i can explain my question here. i have put my question in above uploaded excel file clearly. Please can any body help as it is very important for my project which i am doing for my job. If any friend can help it will much appricated.- Hide quoted text - - Show quoted text - Thanks Joel your macro is working superb. Just little request that if you can explain your macro that who its working so i can have better understaning with your macro. thanks- Hide quoted text - - Show quoted text - Thanks lot Joel it explain a lot. I am using your code and its working superb. just another question i have another code whcih does the smilar job like the macro you gave me but it not gives the msgbox to tell which code or period is not found. Can you please help me in this that what and where i put the code line in macro below so it also give message box that if any code or period not found and then Exit Sub. Please see the macro below (you can put this code in the sheet so you can better understand the function - http://www.savefile.com/files/1535694 ) Sub MultAmt() Const x = 12 Dim i As Integer Dim LRow As Long Dim rng As Range, c As Range Dim rng2 As Range, c2 As Range LRow = Sheets("FORM").Cells(Rows.Count, "A").End(xlUp).Row Set rng = Sheets("FORM").Range("D2:D" & LRow) LRow = Sheets("RESULT BY MACRO").Cells(Rows.Count, "A").End(xlUp).Row If LRow = 1 Then 'do nothing Else Sheets("RESULT BY MACRO").Rows("2:" & LRow).Delete End If i = 1 For Each c In rng LRow = Sheets("RESULT BY MACRO").Cells(Rows.Count, "A").End(xlUp).Row c.EntireRow.Copy Sheets("RESULT BY MACRO").Range("A" & LRow + i & ":A" & LRow + x) Next LRow = Sheets("RESULT BY MACRO").Cells(Rows.Count, "A").End(xlUp).Row Set rng = Sheets("RESULT BY MACRO").Range("D2:D" & LRow) LRow = Sheets("PERCENTAGES DATA").Cells(Rows.Count, "A").End(xlUp).Row Set rng2 = Sheets("PERCENTAGES DATA").Range("A3:M" & LRow) i = 2 For Each c In rng c.Offset(, 1).Value = c.Offset(, 1).Value * _ (Application.WorksheetFunction.VLookup(c.Value, rng2, i, False) / 100) c.Offset(, 3).Value = Sheet1.Cells(2, i).Value If i = 13 Then i = 2 Else i = i + 1 End If Next End Sub |
| All times are GMT +1. The time now is 05:01 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com