Adding some additional Rows to great macro

I have a nice Macro created by Andrew Man from Hong Kong that allows you to select a particular "row" and have it total for you on the right side of the WS.  I need some additional rows created at the top (+5) where the totals take place.

That's it!

Thanks in advance.

B.
Compling-the-Value-List-v2.xlsm
Bright01Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Saqib Husain, SyedEngineerCommented:
Try this macro after inserting the rows manually.

Sub sumup()
    Dim O_R As Integer
    'Output Row
    Dim I_R As Integer
    'Input Row
    O_R = Cells(Rows.Count, 17).End(xlUp).Row
    'Targeted Output "Total"
    If O_R > 8 Then
        'Column and Row Output
        Range(Cells(3, 17), Cells(O_R, 18)).ClearContents
    End If
    'Column Explanation
    O_R = 3
    
    'Where the checkmark is
    I_R = Cells(Rows.Count, 6).End(xlUp).Row
    If I_R > 13 Then
        'Input row
        For i = 3 To I_R
            With Cells(i, 6)
                If .Value = "P" Then
                    'Output results here
                    Cells(O_R, 17).Value = .Offset(0, 1).Value
                    Cells(O_R, 18).Value = .Offset(0, 5).Value
                    O_R = O_R + 1
                End If
            End With
        Next
    Else
        MsgBox "Please select what you wanted! Thanks!"
    End If
    
End Sub

Open in new window

0
andrew_manCommented:
Hi all,

I am Andrew Man from Hong Kong!  Better to Teach a Man Fishing Than to Give Him a Fish!

Sub sumup()
Dim O_R As Integer
Dim I_R As Integer

''**** Clear the previous output ****
O_R = Cells(Rows.Count, 17).End(xlUp).Row  ''Search the last row for output
If O_R > 2 Then    ''' Clear if greater than row 2
Range(Cells(3, 17), Cells(O_R, 18)).ClearContents
End If
O_R = 3  ''Fix the output to row 3

I_R = Cells(Rows.Count, 6).End(xlUp).Row  ''Find the last row for input range
If I_R > 8 Then
For i = 9 To I_R
With Cells(i, 6)
If .Value = "P" Then
Cells(O_R, 17).Value = .Offset(0, 1).Value
Cells(O_R, 18).Value = .Offset(0, 5).Value
O_R = O_R + 1
End If
End With
Next
Else
MsgBox "Please select what you wanted! Thanks!"
End If

End Sub
Compling-the-Value-List-v3.xlsm
0
andrew_manCommented:
O_R > 8 is incorrected!
0
Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

andrew_manCommented:
Dear Bright01,

Please dun close this thread!

I want to tell you more!

Thanks!

Andrew Man
0
andrew_manCommented:
Dear Bright01,

Thousand Thanks for ssaqibh.

In my real life case, I will tell my subordinates using more constant rather than hard code to the program.

So, please dun remember to give some marks to ssaqibh.  Thanks!  Keep in touch!

You can close the thread now.  Thanks!

Andrew from Hong Kong

Sub sumup()
Const Input_Range = 9
Const Output_Range = 3
Const Output_CS = 17
Const Output_CE = 18
Const Input_CM = 6

Dim O_R As Integer
'Output Row
Dim I_R As Integer
'Input Row
Dim Total As Integer
'Total

'**** Clear the previous output ****
O_R = Cells(Rows.Count, Output_CS).End(xlUp).Row
    If O_R >= Output_Range Then
    'Column and Row Output
    Range(Cells(Output_Range, Output_CS), Cells(O_R, Output_CE)).ClearContents
    End If
'Column Explanation
O_R = Output_Range


'Where the checkmark is
I_R = Cells(Rows.Count, Input_CM).End(xlUp).Row
If I_R >= Input_Range Then
'Input row
For i = Input_Range To I_R
With Cells(i, Input_CM)
If .Value = "P" Then
'Output results here
Cells(O_R, Output_CS).Value = .Offset(0, 1).Value
Cells(O_R, Output_CE).Value = .Offset(0, 5).Value
Cells(O_R, Output_CE).NumberFormatLocal = _
        "_(""$""* #,##0_);_(""$""* (#,##0);_(""$""* ""-""??_);_(@_)"

Total = Total + .Offset(0, 5).Value
O_R = O_R + 1
End If
End With
Next
Cells(Output_Range - 1, Output_CS).Value = "Total"
With Cells(Output_Range - 1, Output_CE)
.Value = Total
.NumberFormatLocal = _
        "_(""$""* #,##0_);_(""$""* (#,##0);_(""$""* ""-""??_);_(@_)"
End With
Else

MsgBox "Please select what you wanted! Thanks!"
End If

End Sub

Open in new window

Compling-the-Value-List-v4.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Saqib Husain, SyedEngineerCommented:
Hi, Andrew Man from Hong Kong, how about a detailed intro in your profile?
0
andrew_manCommented:
Hi Ssaqibh,

Updated my profile, if you want to know me more?  You can send me an email.

Andrew Man from Hong Kong
0
Bright01Author Commented:
Andrew and Ssaqibh,

Great Teamwork!  And Andrew, your code is very clean and works very well!  

I will be Posting another question about how to "automatically" provide/drive the updates instead of using the button.  Hopefully you guys will pick it up.

Again, much thanks.......

B.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.