Carbon Footprint Calculator problem

Emma35 · #1 05-29-2015, 01:02 AM

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

excelledsoftware · #2 05-31-2015, 05:50 PM

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

Emma35 · #3 06-02-2015, 02:13 AM

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

excelledsoftware · #4 06-02-2015, 05:30 PM

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

Let me know if you have any questions.

Thanks

Emma35 · #5 06-03-2015, 07:47 AM

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.

charlesdh · #6 06-03-2015, 11:00 AM

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"

excelledsoftware · #7 06-03-2015, 05:52 PM

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

Emma35 · #8 06-04-2015, 04:07 AM

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 ?

excelledsoftware · #9 06-04-2015, 08:35 AM

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

Emma35 · #10 06-04-2015, 08:57 AM

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

charlesdh · #11 06-04-2015, 11:08 AM

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

excelledsoftware · #12 06-04-2015, 08:11 PM

No intrusion at all Charles. Thanks for updating it. Emma is it working now?

Emma35 · #13 06-05-2015, 06:38 AM

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

NoSparks · #14 06-05-2015, 08:47 AM

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

excelledsoftware · #15 06-05-2015, 10:29 PM

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

Emma go ahead and replace the existing code with this one and then you can set the range and preview to whatever you want.

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