Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > MACRO TO MULTIPLY AMOUNTS WITH PERCENTAGES
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 557
Default 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.
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default 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.

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 557
Default 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
Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default 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

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 557
Default 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
Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default 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

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro - If bold then multiply by -1 [email protected][_2_] Excel Programming 4 May 31st 07 12:10 PM
Automatically populate and multiply amounts Martin Excel Discussion (Misc queries) 1 December 14th 06 05:08 PM
11 $ amounts, 6 of the amounts must equal $3854.12, which 6? Marianne Excel Discussion (Misc queries) 2 August 26th 06 12:39 AM
Macro to Sort Variable amounts of Data loophole21 Excel Programming 2 July 26th 06 05:36 AM
Macro to automatically add amounts Diggsy Excel Programming 1 July 7th 06 11:14 PM


All times are GMT +1. The time now is 02:08 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement