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