Excel function needed

[smoborny]

I am seeking help designing function or macros that will perform th
following task:

Allow a user to select a specific base model non living quarter traile
and have a function input the price in the blank cell under list price
I would like this to be as simple for the user as possible. I would lik
the user to click on the corresponding cell to whatever trailer tha
they desire, and have the function or macro input directly into the blu
cells near the bottom of the page. If anybody that can come up wit
something that would work to complete this task, that would be great. I
you need more information, just let me know.

Thank

+-------------------------------------------------------------------
|Filename: excelbanter.jpg
|Download: http://www.excelbanter.com/attachment.php?attachmentid=893
+-------------------------------------------------------------------

 

[Ron Rosenfeld]

I am seeking help designing function or macros that will perform the
following task:

Allow a user to select a specific base model non living quarter trailer
and have a function input the price in the blank cell under list price.
I would like this to be as simple for the user as possible. I would like
the user to click on the corresponding cell to whatever trailer that
they desire, and have the function or macro input directly into the blue
cells near the bottom of the page. If anybody that can come up with
something that would work to complete this task, that would be great. If
you need more information, just let me know.

Thanks


+-------------------------------------------------------------------+
|Filename: excelbanter.jpg |
|Download: http://www.excelbanter.com/attachment.php?attachmentid=893|
+-------------------------------------------------------------------+

Suggest you post a workbook, with the data entered, rather than a picture. For those of us who want to respond, it would sure save us some time as we would not have to generate the workbook.

 

[smoborny]

Here you go, thanks for your suggestio

+-------------------------------------------------------------------
|Filename: Book1.zip
|Download: http://www.excelbanter.com/attachment.php?attachmentid=895
+-------------------------------------------------------------------

 

[Ron Rosenfeld]

Here you go, thanks for your suggestion


+-------------------------------------------------------------------+
|Filename: Book1.zip |
|Download: http://www.excelbanter.com/attachment.php?attachmentid=895|
+-------------------------------------------------------------------+

If your real data layout is pretty close to what you've posted, the following Event Macro should do what you want.

To enter this event-triggered Macro, right click on the sheet tab.
Select "View Code" from the right-click drop-down menu.
Then paste the code below into the window that opens.


=====================================
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range
Dim rTS As Range
Dim rPrice As Range
Dim s As String, cost As Double

Set r = Range("a1", Cells(Rows.Count, "A").End(xlUp)).Resize(columnsize:=10)
If Not Intersect(Target, r) Is Nothing Then
Set rTS = Cells.Find(what:="TRAILER SHELL (NO LQ)", after:=[a1], _
LookIn:=xlValues, lookat:=xlPart, searchdirection:=xlNext, _
MatchCase:=True)
Set rPrice = Cells.Find(what:="List", after:=rTS, searchorder:=xlByRows)
If rTS Is Nothing Or rPrice Is Nothing Then
MsgBox ("No place for results")
Exit Sub
End If
Set rTS = rTS.Offset(rowoffset:=1)
Set rPrice = rPrice.Offset(rowoffset:=1)
If IsNumeric(Target) And Len(Target) > 0 Then
cost = Target.Value
s = Cells(Target.Row, "A").Text & ", " & _
Target.End(xlUp).Text & ", " & _
Cells(Target.End(xlUp).Row - 1, "A").Text
End If
rTS = s
rPrice = cost
rPrice.NumberFormat = "$#,##0"
End If
End Sub
===========================================

 

[Ron Rosenfeld]

Here you go, thanks for your suggestion


+-------------------------------------------------------------------+
|Filename: Book1.zip |
|Download: http://www.excelbanter.com/attachment.php?attachmentid=895|
+-------------------------------------------------------------------+

Looking also at your "picture" where you indicate more clearly how you want the Trailer Shell data entered, I made some changes to the VBA Code in my previous post:

==================================
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range
Dim rTS As Range
Dim rPrice As Range
Dim s As String, cost As Double

Application.EnableEvents = False
Set r = Range("a1", Cells(Rows.Count, "A").End(xlUp)).Resize(columnsize:=10)
Set r = r.SpecialCells(xlCellTypeConstants, xlNumbers)

If Not Intersect(Target, r) Is Nothing Then
Set rTS = Cells.Find(what:="TRAILER SHELL (NO LQ)", after:=[a1], _
LookIn:=xlValues, lookat:=xlPart, searchdirection:=xlNext, _
MatchCase:=True)
Set rPrice = Cells.Find(what:="List", after:=rTS, searchorder:=xlByRows)
If rTS Is Nothing Or rPrice Is Nothing Then
MsgBox ("No place for results")
Exit Sub
End If
Set rTS = rTS.Offset(rowoffset:=1)
Set rPrice = rPrice.Offset(rowoffset:=1)
cost = Target.Value
s = Replace(Cells(Target.End(xlUp).Row - 1, "A").Text, "/", " x ") & _
" / " & Cells(Target.Row, "A").Text & " / " & _
Target.End(xlUp).Text & " Short Wall"
rTS = s
rPrice = cost
rPrice.NumberFormat = "$#,##0"
End If
Application.EnableEvents = True
End Sub
===========================================

 

[smoborny]

I am impressed, thanks for such a quick response! Now I am in th
process of allowing the code to work in my complete project. I have bee
attempting this for a couple hours and haven't got anywhere. If th
prices you seen on the zip file that I uploaded were referenced back t
a different workbook would I have to change the code

+-------------------------------------------------------------------
+-------------------------------------------------------------------

 

[smoborny]

Just curious if you could post a description of what is bein
accomplished next to each line of code, so I can understand it better.
am going to have to use this code in other projects and I would like t
be able to do it myself. Thanks in advance

+-------------------------------------------------------------------
+-------------------------------------------------------------------

 

[smoborny]

Once again great job on designing that macro. All I need now is for i
to function with 3 different "tables" on the same sheet. Here is what
am working wit

+-------------------------------------------------------------------
|Filename: Book1.zip
|Download: http://www.excelbanter.com/attachment.php?attachmentid=897
+-------------------------------------------------------------------

 

[Ron Rosenfeld]

Just curious if you could post a description of what is being
accomplished next to each line of code, so I can understand it better. I
am going to have to use this code in other projects and I would like to
be able to do it myself. Thanks in advance!


+-------------------------------------------------------------------+
+-------------------------------------------------------------------+

Here is the code with some explanation -- not always "next to", but you should be able to figure it out.

 

[Ron Rosenfeld]

I am impressed, thanks for such a quick response! Now I am in the
process of allowing the code to work in my complete project. I have been
attempting this for a couple hours and haven't got anywhere. If the
prices you seen on the zip file that I uploaded were referenced back to
a different workbook would I have to change the code?

I don't know what you mean by "referenced back to a different workbook"
But if the cells showing the prices really contain a formula, rather than a number as shown in the worksheet you sent, then the code would need to be changed.

 

[Ron Rosenfeld]

Once again great job on designing that macro. All I need now is for it
to function with 3 different "tables" on the same sheet. Here is what I
am working with


+-------------------------------------------------------------------+
|Filename: Book1.zip |
|Download: http://www.excelbanter.com/attachment.php?attachmentid=897|
+-------------------------------------------------------------------+

In Sheet1!X32 you show "8' WIDE x 7'6" TALL / 5 Horse / 10' Short Wall"

Is that correct or not. I would have thought it should show "LIVING QUARTER TRAILER W/ SLIDE OUT - LIST PRICE"

Also, you will need to save your file as .xlsm or .xlsb. .xlsx will not allow a macro to run

 

[smoborny]

Thank you for all the time you are spending on this and for the tips
Just curious if you forgot the attachment on one of your previous posts
you are also correct that cell was suppose to say "LIVING QUARTE
TRAILER W/ SLIDE OUT - LIST PRICE

+-------------------------------------------------------------------
+-------------------------------------------------------------------

 

[Ron Rosenfeld]

Thank you for all the time you are spending on this and for the tips!
Just curious if you forgot the attachment on one of your previous posts.
you are also correct that cell was suppose to say "LIVING QUARTER
TRAILER W/ SLIDE OUT - LIST PRICE"


+-------------------------------------------------------------------+
+-------------------------------------------------------------------+

Try this macro, entered the same way after selecting the sheet tab and selecting "View Code"

The complexity is required because of your layout.

=============================================
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rTbl() As Range
Dim c As Range, r As Range
Dim sTblHeader() As String
Dim i As Long, j As Long
Dim lFirstRow As Long
Dim lLastRow As Long
Dim lLastCol As Long
'Get Table Headers and cells
Application.EnableEvents = False
Set r = Range("A1", Cells(1, Columns.Count).End(xlToLeft))
i = WorksheetFunction.CountA(r)
ReDim rTbl(1 To i, 0 To 2) 'dim 1 is table, 2 is TS text, 3 is List
ReDim sTblHeader(1 To i, 0 To 1) 'dimension 1 is text, 2 is address
For Each c In r
If Len(c.Text) > 0 Then
j = j + 1
sTblHeader(j, 0) = c.Text
sTblHeader(j, 1) = c.Address
End If
Next c

For i = 1 To UBound(sTblHeader) 'iterate for each table
'get first row of table
With Cells
Set c = .Find(what:="Horse", after:=Range(sTblHeader(i, 1)), LookIn:=xlValues, _
lookat:=xlPart, searchdirection:=xlNext, searchorder:=xlByColumns, _
MatchCase:=True)
lFirstRow = c.Row
lLastCol = c.End(xlToRight).Column
Set c = .Find(what:="Horse", after:=Cells(Rows.Count, c.Column), searchdirection:=xlPrevious)
lLastRow = c.Row

'If all of the Prices are formed by functions/formulas, then change xlCellTypeConstants to xlCellTypeFormulas
' in the line below. Leave everything else the same

Set rTbl(i, 0) = Range(Cells(lFirstRow, c.Column + 1), Cells(lLastRow, lLastCol)).SpecialCells(xlCellTypeConstants, xlNumbers)

Set c = .Find(what:=Trim(Left(sTblHeader(i, 0), InStr(sTblHeader(i, 0), "-") - 1)), after:=c, _
LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext)
Set rTbl(i, 1) = c.Offset(rowoffset:=1) 'Trailer Text
Set rTbl(i, 2) = c.Offset(rowoffset:=1, columnoffset:=1) 'List Price

End With
Next i

For i = 1 To UBound(rTbl)
If Not Intersect(Target, rTbl(i, 0)) Is Nothing Then
rTbl(i, 1) = Replace(Cells(Target.End(xlUp).Row - 1, Target.End(xlToLeft).Column).Text, "/", " x ") & _
" / " & Target.End(xlToLeft).Text & " / " & _
Target.End(xlUp).Text & " Short Wall"
rTbl(i, 1).ShrinkToFit = True
rTbl(i, 2) = Target.Value
rTbl(i, 2).NumberFormat = "$#,##0"
End If
Next i
Application.EnableEvents = True
End Sub
=================================================

 

[Ron Rosenfeld]

Thank you for all the time you are spending on this and for the tips!
Just curious if you forgot the attachment on one of your previous posts.
you are also correct that cell was suppose to say "LIVING QUARTER
TRAILER W/ SLIDE OUT - LIST PRICE"


+-------------------------------------------------------------------+
+-------------------------------------------------------------------+

And here is the forgotten attachment. This will NOT work on your current data, but it is annotated.

=============================
Option Explicit
'triggers when a new cell is selected on this worksheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Target is the cell that has just been selected
Dim r As Range
Dim rTS As Range 'tractor shell data will be copied here
Dim rPrice As Range 'price data will be copied here
Dim s As String, cost As Double

Application.EnableEvents = False 'don't trigger on any more changes
Set r = Range("a1", Cells(Rows.Count, "A").End(xlUp)).Resize(columnsize:=10)
' r is set to all the rows in column A for row 1 to the last row used
'this is good since the Trailer shell at the bottom does not occupy anything in column A

Set r = r.SpecialCells(xlCellTypeConstants, xlNumbers)
'refines r to only refer to cells with numbers in them. This will be the
' price cells in the table

If Not Intersect(Target, r) Is Nothing Then 'Is target in one of the 'r' cells?
'yes, so do the following:
Set rTS = Cells.Find(what:="TRAILER SHELL (NO LQ)", after:=[a1], _
LookIn:=xlValues, lookat:=xlPart, searchdirection:=xlNext, _
MatchCase:=True) 'cell to copy trailer shell stuff
Set rPrice = Cells.Find(what:="List", after:=rTS, searchorder:=xlByRows)
'cell to copy Price data

If rTS Is Nothing Or rPrice Is Nothing Then 'check that the rTS and rPrice cells exist
MsgBox ("No place for results")
Exit Sub
End If
Set rTS = rTS.Offset(rowoffset:=1) 'rTS should be one row below the cell containing the phrase "TRAILER SHELL (NO LQ)"
Set rPrice = rPrice.Offset(rowoffset:=1) 'rPrice should be one row below the cell containing the word "List"
cost = Target.Value 'Target was the selected cell which contains the price


'Line 1 below: from Target, up-arrow gets to short wall information; up one more row
' and in column A gets to Wide x Tall data
' need to replace the "/" with a " x " to meet your specs
'Line 2 below: same row as Target in column A contains the n Horses data
s = Replace(Cells(Target.End(xlUp).Row - 1, "A").Text, "/", " x ") & _
" / " & Cells(Target.Row, "A").Text & " / " & _
Target.End(xlUp).Text & " Short Wall"
rTS = s
rPrice = cost
rPrice.NumberFormat = "$#,##0"
End If
Application.EnableEvents = True
End Sub
===========================================

 

[smoborny]

Try this macro, entered the same way after selecting the sheet tab an
selecting "View Code"

The complexity is required because of your layout.

=============================================
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rTbl() As Range
Dim c As Range, r As Range
Dim sTblHeader() As String
Dim i As Long, j As Long
Dim lFirstRow As Long
Dim lLastRow As Long
Dim lLastCol As Long
'Get Table Headers and cells
Application.EnableEvents = False
Set r = Range("A1", Cells(1, Columns.Count).End(xlToLeft))
i = WorksheetFunction.CountA(r)
ReDim rTbl(1 To i, 0 To 2) 'dim 1 is table, 2 is TS text, 3 is List
ReDim sTblHeader(1 To i, 0 To 1) 'dimension 1 is text, 2 is address
For Each c In r
If Len(c.Text) > 0 Then
j = j + 1
sTblHeader(j, 0) = c.Text
sTblHeader(j, 1) = c.Address
End If
Next c

For i = 1 To UBound(sTblHeader) 'iterate for each table
'get first row of table
With Cells
Set c = .Find(what:="Horse", after:=Range(sTblHeader(i, 1))
LookIn:=xlValues, _
lookat:=xlPart, searchdirection:=xlNext
searchorder:=xlByColumns, _
MatchCase:=True)
lFirstRow = c.Row
lLastCol = c.End(xlToRight).Column
Set c = .Find(what:="Horse", after:=Cells(Rows.Count, c.Column)
searchdirection:=xlPrevious)
lLastRow = c.Row

'If all of the Prices are formed by functions/formulas, then chang
xlCellTypeConstants to xlCellTypeFormulas
' in the line below. Leave everything else the same

Set rTbl(i, 0) = Range(Cells(lFirstRow, c.Column + 1)
Cells(lLastRow, lLastCol)).SpecialCells(xlCellTypeConstants, xlNumbers)

Set c = .Find(what:=Trim(Left(sTblHeader(i, 0), InStr(sTblHeader(i
0), "-") - 1)), after:=c, _
LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByRows
searchdirection:=xlNext)
Set rTbl(i, 1) = c.Offset(rowoffset:=1) 'Trailer Text
Set rTbl(i, 2) = c.Offset(rowoffset:=1, columnoffset:=1) 'Lis
Price

End With
Next i

For i = 1 To UBound(rTbl)
If Not Intersect(Target, rTbl(i, 0)) Is Nothing Then
rTbl(i, 1) = Replace(Cells(Target.End(xlUp).Row - 1
Target.End(xlToLeft).Column).Text, "/", " x ") & _
" / " & Target.End(xlToLeft).Text & " / " & _
Target.End(xlUp).Text & " Short Wall"
rTbl(i, 1).ShrinkToFit = True
rTbl(i, 2) = Target.Value
rTbl(i, 2).NumberFormat = "$#,##0"
End If
Next i
Application.EnableEvents = True
End Sub
=================================================

Very good! works just as I was imagining! I am very impressed! Wha
variables would I have to change if I added information preceding the cos
tables? Say the charts would start at CH3. Thanks again, you are a lif
save

+-------------------------------------------------------------------
+-------------------------------------------------------------------

 

[smoborny]

Also just curious if there was a way to make the macro input only th
most current selection into the corresponding cell, and eliminate th
previous inputs. For Example, if I clicked for a 7'2" wide 7' tall /
Horse / 4'5" Short Wall under "Trailer Shell (No LQ)" -- the macr
inputs the corresponding information directly below the Trailer shell n
lq and list price -- (we will call this step A) then say I clicked o
the 7'2" WIDE / 7' Tall / 6 Horse / 4'5" Short Wall under "Livin
Quarter Trailer" --the macro inputs the corresponding informatio
directly below the Living Quarter trailer and list price -- (we wil
call this step B) ((At this time there are 2 different models displaye
at the bottom, I would like for there to be only the most curren
selection.)) I would like for the macro to remove the previous input an
only display the most current selection. In other words if I complete
step A and B, the macro would only display the results of step B

+-------------------------------------------------------------------
+-------------------------------------------------------------------

 

[Ron Rosenfeld]

Also just curious if there was a way to make the macro input only the
most current selection into the corresponding cell, and eliminate the
previous inputs. For Example, if I clicked for a 7'2" wide 7' tall / 2
Horse / 4'5" Short Wall under "Trailer Shell (No LQ)" -- the macro
inputs the corresponding information directly below the Trailer shell no
lq and list price -- (we will call this step A) then say I clicked on
the 7'2" WIDE / 7' Tall / 6 Horse / 4'5" Short Wall under "Living
Quarter Trailer" --the macro inputs the corresponding information
directly below the Living Quarter trailer and list price -- (we will
call this step B) ((At this time there are 2 different models displayed
at the bottom, I would like for there to be only the most current
selection.)) I would like for the macro to remove the previous input and
only display the most current selection. In other words if I completed
step A and B, the macro would only display the results of step B.


+-------------------------------------------------------------------+
+-------------------------------------------------------------------+

Try this:

===================================
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rTbl() As Range
Dim c As Range, r As Range
Dim sTblHeader() As String
Dim i As Long, j As Long
Dim lFirstRow As Long
Dim lLastRow As Long
Dim lLastCol As Long
'Get Table Headers and cells
Application.EnableEvents = False
Set r = Range("A1", Cells(1, Columns.Count).End(xlToLeft))
i = WorksheetFunction.CountA(r)
ReDim rTbl(1 To i, 0 To 2) 'dim 1 is table, 2 is TS text, 3 is List
ReDim sTblHeader(1 To i, 0 To 1) 'dimension 1 is text, 2 is address
For Each c In r
If Len(c.Text) > 0 Then
j = j + 1
sTblHeader(j, 0) = c.Text
sTblHeader(j, 1) = c.Address
End If
Next c

For i = 1 To UBound(sTblHeader) 'iterate for each table
'get first row of table
With Cells
Set c = .Find(what:="Horse", after:=Range(sTblHeader(i, 1)), LookIn:=xlValues, _
lookat:=xlPart, searchdirection:=xlNext, searchorder:=xlByColumns, _
MatchCase:=True)
lFirstRow = c.Row
lLastCol = c.End(xlToRight).Column
Set c = .Find(what:="Horse", after:=Cells(Rows.Count, c.Column), searchdirection:=xlPrevious)
lLastRow = c.Row

'If all of the Prices are formed by functions/formulas, then change xlCellTypeConstants to xlCellTypeFormulas
' in the line below. Leave everything else the same

Set rTbl(i, 0) = Range(Cells(lFirstRow, c.Column + 1), Cells(lLastRow, lLastCol)).SpecialCells(xlCellTypeConstants, xlNumbers)

Set c = .Find(what:=Trim(Left(sTblHeader(i, 0), InStr(sTblHeader(i, 0), "-") - 1)), after:=c, _
LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext)
Set rTbl(i, 1) = c.Offset(rowoffset:=1) 'Trailer Text
Set rTbl(i, 2) = c.Offset(rowoffset:=1, columnoffset:=1) 'List Price

End With
Next i

For i = 1 To UBound(rTbl)
If Not Intersect(Target, rTbl(i, 0)) Is Nothing Then
rTbl(i, 1) = Replace(Cells(Target.End(xlUp).Row - 1, Target.End(xlToLeft).Column).Text, "/", " x ", 1, 1) & _
" / " & Target.End(xlToLeft).Text & " / " & _
Target.End(xlUp).Text & " Short Wall"
rTbl(i, 1).ShrinkToFit = True
rTbl(i, 2) = Target.Value
rTbl(i, 2).NumberFormat = "$#,##0"

'clear other entries
For j = 1 To UBound(rTbl)
If j <> i Then
rTbl(j, 1).MergeArea.ClearContents
rTbl(j, 2).ClearContents
End If
Next j

End If
Next i
Application.EnableEvents = True
End Sub
=====================================

 

[Ron Rosenfeld]

Very good! works just as I was imagining! I am very impressed! What
variables would I have to change if I added information preceding the cost
tables? Say the charts would start at CH3. Thanks again, you are a life
saver

If what you did is move the entire block of data that you presented previously, to start at CH3, and there is nothing either below or to the right of the table, then the only thing you need to change is the line that sets r to the data range.


Current:
Set r = Range("A1", Cells(1, Columns.Count).End(xlToLeft))

Change to
Set r = Range("CH3", Cells(3, Columns.Count).End(xlToLeft))

You are changing both the first cell from A1 to CH3, and also the first row (in the second Range argument) from 1 to 3.

 

[smoborny]

;1613118']On Mon, 5 Aug 2013 16:15:26 +0100, smoborn

Very good! works just as I was imagining! I am very impressed! What
variables would I have to change if I added information preceding th cost
tables? Say the charts would start at CH3. Thanks again, you are life
saver-

If what you did is move the entire block of data that you presente
previously, to start at CH3, and there is nothing either below or to th
right of the table, then the only thing you need to change is the lin
that sets r to the data range.


Current:
Set r = Range("A1", Cells(1, Columns.Count).End(xlToLeft))

Change to
Set r = Range("CH3", Cells(3, Columns.Count).End(xlToLeft))

You are changing both the first cell from A1 to CH3, and also the firs
row (in the second Range argument) from 1 to 3.

Unfortunately I have data to the right of the block of data we have bee
working with. I assume this will mess with the current .end(xlToLeft)
Thanks again for your time and patience, I am a novice with an interes
in writing user defined functions

+-------------------------------------------------------------------
+-------------------------------------------------------------------

 

[Ron Rosenfeld]

Unfortunately I have data to the right of the block of data we have been
working with. I assume this will mess with the current .end(xlToLeft) .
Thanks again for your time and patience, I am a novice with an interest
in writing user defined functions.

You should take note of the fact that incomplete and incorrect descriptions of your data, problems, etc will often lead to solutions that work perfectly OK on what you show, but won't work on what you really have.
You should take the time to present an accurate synopsis of your actual data, problem, and desired results, rather than hoping that, by taking shortcuts, solutions will be quicker.

When you get around to it, try to present a more realistic set of data.