#1
|
|||
|
|||
Carbon Footprint Calculator problem
Hi all,
My name is Emma and this is my first post so hoping you can help me. I'm working on a carbon footprint calculator and i have a table which works out carbon emmissions for car usage. The table has 'Miles Travelled' across the top and 'MPG' down the side (see attached). I would like the user to be able to make a selection from the table, and that selection to then appear in another cell somewhere else on the worksheet. If they change their mind then the other cell would also update to the new selection. Is this possible ? Hope i've explained it ok. Any help would be greatly appreciated Thanks Em |
#2
|
|||
|
|||
Sure this is possible but it will require code to do it. Can you provide the following and I will write this out for you.
1. What cell do you want the preview to be in? 2. Can you post a sample workbook or at least let me know if the data you show in the picture is in cells A1 to D6? Thanks |
#3
|
|||
|
|||
Hi and thanks for your help. Yes the data would be in A1 to D6. You can just pick any cell for the preview, i can just change it if i need to.
Thanks again |
#4
|
|||
|
|||
Ok This attempts to set up the range of where the cursor can return a value and where it should be ignored. The line says Set Preview is where you change the preview cell in between the quotes.
You need to insert this code into the worksheet module. To do so open your workbook, press ALT + F11, on the left side of the new screen you will see VBAProject followed by your workbook name. Double click the sheet below that has the data and then paste the following code in. Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Preview As Range, BlankCol As Long, BlankRow As Long Dim StartRow As Long, StartCol As Long Set Preview = Range("M1") 'Set the reference you want 'Set other references StartRow = 2 StartCol = 1 'Auto set the boundaries BlankCol = Cells(StartRow, StartCol + 1).End(xlToRight).Column + 1 BlankRow = Cells(StartRow, StartCol + 1).End(xlDown).Row + 1 'Ensure you are in the right area If Target.Column < BlankCol And Target.Column > StartCol Then If Target.Row < BlankRow And Target.Row > StartRow Then Preview = Target.Value End If End If End Sub Thanks |
#5
|
|||
|
|||
Ok so when i open the workbook and press Alt + F11 i only see the screen attached. I tried using the Insert menu to enter the code but nothing was happening on the worksheet after i did it.
|
#6
|
|||
|
|||
HI,
I attached a workbook that has the code proved to you. You can "Right" click sheet1 tab and select "View Code" this will tak you to the code module for "Sheet1" |
#7
|
|||
|
|||
Thanks for that Charles. Emma if that still dosnt work just go to view tab in the basic editor and be sure that you click on Project Explorer or press CTRL + R then complete the above steps.
Thanks |
#8
|
|||
|
|||
Ah yes thank you both it seems to be working now. I've been trying to reposition it to another part of the worksheet but can't seem to get it to work...can you tell me for example how i could get it to start from cell D15 ?
|
#9
|
|||
|
|||
Right now the code starts at A2 due to the StartRow saying 2 and the StartCol saying 1. So to get it to start at D15 you would change the StartRow to 15 and the StartCol to 4.
Let me know if this works. Thanks |
#10
|
|||
|
|||
Thanks for your patience. I reset the StartRow to 15 and StartCol to 5 but it doesn't seem to work until column 6 and row 16. Then only the first line works (on the attached)
Em |
#11
|
|||
|
|||
HI,
Sorry to intrude. But, I modified the code. The data in the workbook started in row 16. And I add the 'Application Event" Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Preview As Range, BlankCol As Long, BlankRow As Long Dim StartRow As Long, StartCol As Long Set Preview = Range("M1") 'Set the reference you want 'Set other references Application.EnableEvents = False '' Added StartRow = 16 ''' data started on row 16 StartCol = 5 'Auto set the boundaries BlankCol = Cells(StartRow, StartCol + 1).End(xlToRight).Column + 1 BlankRow = Cells(StartRow, StartCol + 1).End(xlDown).Row + 1 'Ensure you are in the right area If Target.Column < BlankCol And Target.Column > StartCol Then If Target.Row < BlankRow And Target.Row > StartRow Then Preview = Target.Value End If End If Application.EnableEvents = True ''' added End Sub |
#12
|
|||
|
|||
No intrusion at all Charles. Thanks for updating it. Emma is it working now?
|
#13
|
|||
|
|||
I added the new code but from the attached sheet you can see i started on Row 16 and column 5 but the first row of numbers (16) doesn't work. It starts to preview the numbers properly when it reaches number 7 on the second row. Sorry for dragging this out guys
|
#14
|
|||
|
|||
Am I missing something ?
Wouldn't this suffice ? Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Intersect(Target, Range("E16:I18")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub Else Range("M1").Value = Target.Value End If End Sub |
#15
|
|||
|
|||
NoSparks, thanks so much for your contribution. I actually have never used intersect before and it really looks like the best way to write this out. I have taken your contribution and updated the worksheet module to something that works really well.
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Preview As Range, DataRange As Range 'Set references Set Preview = Range("M1") Set DataRange = Range("E16:I18") 'Ensure you are in the right area Application.EnableEvents = False If Intersect(Target, DataRange) Is Nothing Or Target.Cells.Count > 1 Then Application.EnableEvents = True Exit Sub Else Preview = Target.Value End If Application.EnableEvents = True End Sub Thanks to both Charles and NoSparks for their help. |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Result Calculator | Raza | Excel Programming | 7 | 01-26-2015 11:35 PM |
Excel Calculator | Mandusin | Excel | 6 | 12-25-2010 07:34 AM |
Age Calculator in MS Outlook 2002 SP3 | turns | Outlook | 0 | 06-15-2010 12:26 AM |
**FIND OUT WHO WAS BCC(BLIND CARBON COPIED) ON YOUR EMAILS?? | sharpescalade | Outlook | 1 | 11-30-2006 08:07 AM |