Solved: Creat Macro

[nuttycongo]

Hello Forum,
I want to creat a macro based on certain conditions .I am new to VBA so I am posting a workbook for consideration.Any help would be appreciated.
Regards

[Simon Lloyd]

It would help if you described your "certain conditions" and what you want to achieve, it may be that you do not need VBA to do it.

[nuttycongo]

The conditions are laid down pretty clearly in the attachment ..still here are they :
Conditions:: Then The:: Outcome

a>0,b>0,c>0 ::THEN Outcome :: All
a>0:: then outcome :: b1
a>0,b>0:: then the outcome:: b1,b2
a>0,c>0:: then:: b1,b3
b>0:: then ::b2
so on and so forth.I know writing a fiunction will be the best thing but I am insisting on a macro for two reasons:
1/ Data base is huge
2/ I can tweak it for many similar requirement once I understand it .
This is a cross post and I am not allowed to display the link
To be able to post links your post count must be 5 or greater. Your post count is 1 momentarily.Please remove links from your message, then you will be able to submit your post. Reason I am trying to generate a Macro and not a function.I will be obliged if you can suggest ..in any case I will keep the developments posted here as well to avoid contributors from wasting their valuable time if the post is answered.
Regards

[Simon Lloyd]

Can you supply a layout of how your live workbook is so i don't go to the trouble of coding for your example?

[nuttycongo]

attached is the worksheet ..
Regards

[nuttycongo]

PS:
Condition "Send" and "Send to D1" should be read as same in the attachment..

[Simon Lloyd]

Try this in a standard moduleSub Outcomes()
Dim rng As Range, MyCell As Range
MsgBox Range("AA" & Rows.Count).End(xlUp).Address
Set rng = Range("AA2:AA" & Range("AA" & Rows.Count).End(xlUp).Row)
For Each MyCell In rng
Select Case MyCell
Case "C,B2,B3", "B1,B3"
MyCell.Offset(0, 1).Value = "Remind,Escalate"
Case "U,B1,B3", "U,C,B1,B2,B3"
MyCell.Offset(0, 1).Value = "send ,Remind,Escalate"
Case u
MyCell.Offset(0, 1).Value = "Send"
Case "B1", "B1,B2"
MyCell.Offset(0, 1).Value = "Remind"
Case "B1,B2,B3"
MyCell.Offset(0, 1).Value = "Escalate"
Case "C"
MyCell.Offset(0, 1).Value = "No Outcome"
End Select
Next MyCell
End Sub

[nuttycongo]

Hello Simon,
Thank You for the effort ,I think I got You mighty confused here .Let me try and correct myself I am looking at two solutions after Macro is initiated
1/ Conditions 2/ Remarks I am attaching worksheet explaining a bit better hopefully..
Regards

[Simon Lloyd]

Ok so i guess when you say B1, B2 you don't mean range B1, B2 you mean your column headers? and in outcomes you don't type in C,B1,B2...etc or do you, if you do are you expecting to look up each column by the text you type?

Although you have produced a few examples all pretty much looking the same you haven't really made it clear what you want, you may understand but then you designed it, so saying to me "Outcomes" means nothing more to me than a title, not how you arrive at it, how you populate it or what you expect to see in it.

Imagine you have a 10yr old that you want to explain this to...........got it?, right i'm the 10yr old :)

[nuttycongo]

Thank you Simon..I am glad you replied back ,Well I am ok explaining to a 10 year old as my excel IQ is right now in of a new born .:rotlaugh:

Ok so i guess when you say B1, B2 you don't mean range B1, B2 you mean your column headers U C B1 B2 B3 are header in the range column E:G.Lets say , so if any value in the range G2:G900+ is > 0,then the returning Value in the column Range AA will be Header "B1" and if AA has a B1 then the Remark in column AB should be "Reminder".So based on Condition in Range Column G the outcome of Range Column AA is decided and based on value in range column AA outcome in AB is decided.
and in outcomes you don't type in C,B1,B2 no it should come up when you run the Macro,based on the values in Range Column E:I
expecting to look up each column by the text you type not possible to do that as the data is more than 6700 rows and is dynamic .
Regards

[Simon Lloyd]

Ok give this a try, there are smarter ways but im just off to bed so just adapted what i'd already given :)Option Explicit
Sub Outcomes()
Dim rng As Range, MyCell As Range, rng1 As Range, oCell As Range
Range("AA2:AB" & Range("AA" & Rows.Count).End(xlUp).Row).ClearContents
Set rng1 = Range("E2:I" & Range("I" & Rows.Count).End(xlUp).Row)
For Each oCell In rng1
If oCell > 0 Then
Range("AA" & oCell.Row) = Range("AA" & oCell.Row) & "," & Cells(1, oCell.Column).Value
End If
Next oCell
For Each oCell In Range("AA2:AA" & Range("AA" & Rows.Count).End(xlUp).Row)
oCell.Value = Right(oCell.Value, Len(oCell) - 1)
oCell.Value = Left(oCell.Value, Len(oCell) - 1)
Next oCell
Set rng = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
For Each MyCell In rng
Select Case MyCell.Offset(0, 23)
Case "C,B2,B3", "B1,B3"
MyCell.Offset(0, 24).Value = "Remind,Escalate"
Case "U,B1,B3", "U,C,B1,B2,B3"
MyCell.Offset(0, 24).Value = "send ,Remind,Escalate"
Case "u"
MyCell.Offset(0, 24).Value = "Send"
Case "B1", "B1,B2"
MyCell.Offset(0, 24).Value = "Remind"
Case "B1,B2,B3"
MyCell.Offset(0, 24).Value = "Escalate"
Case "C"
MyCell.Offset(0, 24).Value = "No Outcome"
End Select
Next MyCell
End Sub

[nuttycongo]

This almost works ,when I run it on tha sample file .Problem area:
Header "Remarks"and "Outcome" Does Not come up in Cell"AA" and "AB".can you fix it ?Therewise this works as required will try it on the database and let you know as well.
Regards

[nuttycongo]

There's bug and it wont let it execute further then the marked line


Option Explicit

Sub Outcomes()
Dim rng As Range, MyCell As Range, rng1 As Range, oCell As Range
Range("AA2:AB" & Range("AA" & Rows.Count).End(xlUp).Row).ClearContents
Set rng1 = Range("E2:I" & Range("I" & Rows.Count).End(xlUp).Row)
For Each oCell In rng1
If oCell > 0 Then
Range("AA" & oCell.Row) = Range("AA" & oCell.Row) & "," & Cells(1, oCell.Column).Value
End If
Next oCell
For Each oCell In Range("AA2:AA" & Range("AA" & Rows.Count).End(xlUp).Row)
oCell.Value = Right(oCell.Value, Len(oCell) - 1):devil2:
oCell.Value = Left(oCell.Value, Len(oCell) - 1)
Next oCell
Set rng = Range("D2" & Range("D" & Rows.Count).End(xlUp).Row)
For Each MyCell In rng
Select Case MyCell.Offset(0, 23)
Case "C,B2,B3", "B1,B3"
MyCell.Offset(0, 24).Value = "Remind,Escalate"
Case "U,B1,B3", "U,C,B1,B2,B3"
MyCell.Offset(0, 24).Value = "send ,Remind,Escalate"
Case "u"
MyCell.Offset(0, 24).Value = "Send"
Case "B1", "B1,B2"
MyCell.Offset(0, 24).Value = "Remind"
Case "B1,B2,B3"
MyCell.Offset(0, 24).Value = "Escalate"
Case "C"
MyCell.Offset(0, 24).Value = "No Outcome"
End Select
Next MyCell
End Sub

[Simon Lloyd]

My original code worked for me no problem!, i have added the headers as you wishOption Explicit
Sub Outcomes()
Dim rng As Range, MyCell As Range, rng1 As Range, oCell As Range
Application.ScreenUpdating= False
Application.calculation=xlManual
Range("AA1").Value = "Outcome"
Range("AB1").Value = "Remarks"
Range("AA2:AB" & Range("AA" & Rows.Count).End(xlUp).Row).ClearContents
Set rng1 = Range("E2:I" & Range("I" & Rows.Count).End(xlUp).Row)
For Each oCell In rng1
If oCell > 0 Then
Range("AA" & oCell.Row) = Range("AA" & oCell.Row) & "," & Cells(1, oCell.Column).Value
End If
Next oCell
For Each oCell In Range("AA2:AA" & Range("AA" & Rows.Count).End(xlUp).Row)
oCell.Value = Right(oCell.Value, Len(oCell) - 1)
oCell.Value = Left(oCell.Value, Len(oCell) - 1)
Next oCell
Set rng = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
For Each MyCell In rng
Select Case MyCell.Offset(0, 23)
Case "C,B2,B3", "B1,B3"
MyCell.Offset(0, 24).Value = "Remind,Escalate"
Case "U,B1,B3", "U,C,B1,B2,B3"
MyCell.Offset(0, 24).Value = "send ,Remind,Escalate"
Case "u"
MyCell.Offset(0, 24).Value = "Send"
Case "B1", "B1,B2"
MyCell.Offset(0, 24).Value = "Remind"
Case "B1,B2,B3"
MyCell.Offset(0, 24).Value = "Escalate"
Case "C"
MyCell.Offset(0, 24).Value = "No Outcome"
End Select
Next MyCell
Application.ScreenUpdating=True
Application.calculation=xlAutomatic
End Sub

[nuttycongo]

you are right.. I am attaching the worksheet which is of actual data size ..the remarks and outcome Headers fail to come up .
Regards

[Simon Lloyd]

You could of worked that bit out :), i'd simply put the creation lines in the wrong place, it's s really simple fix, take a look at the code in your workbook, have the VBE window smaller so you can see AA and AB above the window on the worksheet, position your cursor right next to Sub and click once, now press F8 once for each step, you will see the titles being created and then see them removed, put the creation lines after that line that removes them :)

If you really do have trouble with that then post back and i'll post the code change, but a little investigation like that will help you understand the code better and for future maintainance.

[nuttycongo]

Thank You So much Simon..This has taken me a step ahead in learning VBA. "Give a man a fish and you feed him for a day. Teach a man to fish and you feed him for a lifetime" ..I will mark the thread as solved and also post the same at excel forum ,your scale gets tipped not in reward but in gratitude and appreciation.Hope to keep learning from you master.
Regards

[Simon Lloyd]

So i assume you found the issue and corrected it?

[nuttycongo]

Yes I did and now I am tryin to figure out how to mark this thread solved here :think:Regards

[Simon Lloyd]

Above your first post to the right is "Thread Tools" it's in that drop down :)

[nuttycongo]

Got That ...
Thanks a ton Simon..
Regards