Excel 2007 Linking Multiple Text Part 2

Thank you for helpng me!

I want to do some changes to the attached Excel Spreadsheet.  Inside the spreadsheet (when you open it) you will find some explainations on what I want.  The explainations are in column D



Here is some more
Examples:
If user selects the LINK in column C then:
This is a edit of:
Animals: This is a test From ColumnC I picked Cow
If user selects the LINK in column D then:
This is a edit of:
Books: This is a test from Column D I picked Real
If user selects the LINK in ColumnE then:
Houses: This is a test from Column E I picked Villa

All the mandatory entry is to go in column F

Please help me!


Thank you for helping!  ABCtoD.xls
Amour22015Asked:
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.

Chris Raisin(Retired Analyst/Programmer)Commented:
Can you please clarify your question.

Are you after certain things to happen when a user clicks on certain cells, or are you just asking for some clean-up of the spreadsheet first (like "hiding" header cells, etc?)

What is the purpose of the spreadsheet? (helps me to understand what you are attempting to do).

I only have Excel 2003 or Excel 2010, but that should not matter. I will use 2010 but should still work OK at your end.

I am away for three weeks starting tomorrow for Christmas break, but I will work on this as soon as I get the info from you and have it done within the hour (I hope).

Cheers
Chris (craisin)
Melbourne-Australia
0
gowflowCommented:
Is this what you want ?

PS I did not understand your last comment that you don't want animal and books and Houese to have the same sentence ??? well if you type it there it will take it what ever it is !
anyway check this file and let me know.
gowlfow
CDEtoF.xls
0
Amour22015Author Commented:
gowflow

Thank you,

Where in your code can I see the pick up for the hidden Row 1?

You have almost very thing I am looking for.  Your spreadsheet:  In Column E if I type anything in it writes to Col F (this is correct).  But if I go back to Col E (to edit) it writes another selection this I do not want.

Example:

C: this is correct
D: This is correct
E: This is correct

Now I go back to Col E to edit: E: This is correct.  I type in This is another test

But it returns:

C: this is correct
D: This is correct
E: This is correct
E: This is another test    <==== This part should return to the line above

It seems like Col E is out of the loop in the VBA Code?

Thank You!
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

gowflowCommented:
ok here it is. The edit has been fixed sorry for that.
I had manually hidden row 1 now that you asked I did put it in the code it is this line
If Rows(1).Hidden = False Then Rows(1).Hidden = True

gowflow
CDEtoF.xls
0
Amour22015Author Commented:
gowflow

Thank you for helping!

On this please tell me more:
If Rows(1).Hidden = False Then Rows(1).Hidden = True


I want it to be Row 700 instead of 1?

Also please tell me how to display this so I can make changes to the Hidden Header information?

Thank you!

Thank you
0
gowflowCommented:
if it is row 700 to hide then replace the 1 in both by 700 like this
If Rows(700).Hidden = False Then Rows(700).Hidden = True

this version allows a bit more flexibility. check if you like that !
gowflow
CDEtoF.xls
0
Amour22015Author Commented:
gowflow

Thank you!

I get a run-time error on the button?

Run-Time '1004'

Also I tried the above with 700 I get the same error

I need some clearifying.  I see where you are hidding the Row 1 but I need to know where (in the code) you are picking up the information in Row 1? to place it in Col F?

Thank you!
0
gowflowCommented:
Sorry my mistake. error fixed

I need to know where (in the code) you are picking up the information in Row 1? to place it in Col F?
>>>
In Sub CDEtoF here is where it writes to F
If Range("F1") <> "" Then MaxRow = MaxRow + 2
                If Cells(MaxRow, 6) <> "" Then Cells(MaxRow, 6) = Cells(MaxRow, 6) & Chr(10) & Chr(10)
                Cells(MaxRow, 6) = Cells(MaxRow, 6) & Cells(1, Change.Column) & ": " & Message

and when you make an edit, here is when it write back to F
Cells(MaxRow, 6) = Replace(Cells(MaxRow, 6), Message, MessageNEW)

the 6 is F !!!!
gowflow

0
Amour22015Author Commented:


Thank you!

You did not post the new fixed Spreadsheet?

Again, I need some more clearifying.  I see where you are hidding the Row 1 but I need to know where (in the code) you are picking up the information that is in Row 1?

I thought maybe this:
HeaderCDE = Cells(1, Change.Column)

But when I tried to change it to:
HeaderCDE = Cells(700, Change.Column)

That was not it?


Thank you!
0
gowflowCommented:
ooops !!!
your right but before I attach the file if you tell me why you need line 700 and if this will change I will make it user set so you don't need to play in the code or else will stay here till next year changing and changing ! unless its your own knowledge then I'll be happy to explain.

Basically your right it is the Cells(1, Change.Column) that indicate that it is the header however it comes at several places and because I use same patterns in my programmng then its easy for you to find it.

1) Select this Cells(1, Change.Column) and on the menu choose Edit then click on Find
2) the system will show you all the places this occur there are 4 instances.
3) if you need to change something it is the 1that you need to replace by 700 in all 4.

here is the file still with Line 1 header. Do you want me to chnage something pls be specific. as also you should knwo that the sheet is protected and on row 1 the C1 D1 E1 are not protected to allow you to change the header if you want. so if you want to move this to row 700 you should also unprotect those col in that row as well but the show hide, I don't know how it is going to work as it is sitting in line 2 ! anyway you tell me.

gowflow
CDEtoF.xls
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
Amour22015Author Commented:
gowflow

Thank You,

One more thing?

In your example Column F grows with each selection?

But when I put that into my Spreadsheet it does not grow.  It hides some of the Text.

The request that was given to me was to have Column F locked and to have: "Free Form" in Column F.

Do you know what "Free Form" means?

I think it means that they want to see the mandatory text in Column F

Do you know how I can get these Cells (Column F) to grow when mandatory Text is inputed?

Thank You!
0
gowflowCommented:
Free Form is something new to me don't you think we are moving from one issue to an other and maybe time to close this one and if you want open a specific one we can check out what you want ??? No in quest of point at all I will be ready to help you but sake people following the threads then it becomes totally confusing and does not serve the purpose of offering solution to people having same problem !
gowflow
0
Amour22015Author Commented:
gowflow

Thank you,

You are correct!

So back to the issue.

Your spreadsheet prevents this:

Animals on a farm:
Date of Books:
Date of House:
Date of House:

(All in ColF)

from occurring and this is what I want.  But when I put your code into mine, above happens and this I don't want.

I would like to know how you prevented this from happening?

Thank you!
0
gowflowCommented:
1) ah ok is it possible you post your workbook or not ?
2) I Think this version should fix the little problem there copy it in your workbook and I think it should be fine.
gowflow
CDEtoF.xls
0
Amour22015Author Commented:
gowflow,

Thank you!

When I tried coping your code into my workbook.  The workbook totally went bad.  I started getting errors like:  Recordset out of Range, my color macro did not work anymore.  All was working before I copied the code.  I had to revert back to the last save I did and lost 2 days of code that was in the workbook.

So what ever you did, that did not work.  And the only thing that I noticed was different from your last code was:
ActiveSheet.Protect AllowFiltering:=True

Thank you and please help!
0
Amour22015Author Commented:
gowflow

Thank you,

I am putting the:
Dim TargetIsEmpty As Boolean
Dim IsColUpdated As Boolean
Dim Change As Range
Dim Message As String, MessageNEW As String, HeaderCDE As String
Dim MaxRow As Long
Dim StartMSG As Integer, EndMSG As Integer
Dim CellD As String


all in the Open Event?


Also:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

For Each Change In Target.Cells
    If Change.Text = "" Then
        TargetIsEmpty = True
    Else
        TargetIsEmpty = False
    End If
Next Change
ActiveSheet.Protect AllowFiltering:=True

If Not Intersect(Target, Range("F5:F600")) Is Nothing Then
        If Cells(Target.Row, 6) <> "" Then
            SaveVal = Cells(Target.Row, 6)
        End If
End If
If Not Intersect(Target, Range("K5:K600")) Is Nothing Then
        If Cells(Target.Row, 11) <> "" Then
            SaveVal1 = Cells(Target.Row, 11)
        End If
End If

End Sub

Because of other code should I have this part:

For Each Change In Target.Cells
    If Change.Text = "" Then
        TargetIsEmpty = True
    Else
        TargetIsEmpty = False
    End If
Next Change
ActiveSheet.Protect AllowFiltering:=True

Like this instead?
If Not Intersect(Target, Range("C1:E600")) Is Nothing Then
For Each Change In Target.Cells
    If Change.Text = "" Then
        TargetIsEmpty = True
    Else
        TargetIsEmpty = False
    End If
Next Change
ActiveSheet.Protect AllowFiltering:=True
End If

Please help and thank you!
0
Amour22015Author Commented:
gowflow,

Thank you!

I tried copying your code several times to see if I did not copy properly but evertime I come back into the wookbook I get all the errors?

name font problems, so I stop my Color Macro
Out of Range problems

Thank you!
0
gowflowCommented:
well for sure this is not a copy paste especially if you have code already there. Your asking me to diagnoze a child that is sick without even examining or seeing the child !!!
Sorry can't assist you this way

You have a problem I told you
POST THE WORKBOOK !!!! I will incorporate my code there and make it work like It should beside this sorry cann't assist
gowflow
0
Amour22015Author Commented:
gowflow

Thank you,

The main reason for all this (otherwise I would have came to the point right off) is that this workbook is a Classified for the government so I can not post it.

But back to the previous question, I am going to try and see if that works?

Thank You!
0
gowflowCommented:
ok fine just post the code !!!
gowflow
0
gowflowCommented:
I think the problem you are having is maybe due to the mixed code that exist in the worksheet_change event
could you please post all the code that is related to worksheet
like goto vba doubleclick on the worksheet in the left pane and there you should see some sub and some worksheet related sub if the subs are ones that I wrote then no need to put the ocde I will need the code for the worksheets events then I can see how they interact and propose how to integrate correctly.
gowflow
0
Amour22015Author Commented:
gowflow
Thank and Merry Christmas!

Here is the code in the Change Event:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim SaveValC As String
Dim SaveVal1 As String
Dim fd As FileDialog
Dim link As Range
Dim item As Variant
Dim Obj As Object
Dim IsColUpdated As Boolean

    If Not Intersect(Target, Range("C1:E600")) Is Nothing Then

         'Selected with Other option
        If Cells(Target.Row, 3) = "Other" Then
             'require data entry in Justification Cell
            Application.EnableEvents = False
            'Do While Cells(Target.Row, 3) = ""
                 'Get data from user
                If SaveValC <> "" Then
                    Cells(Target.Row, 3) = InputBox("Enter data for CLASSIFICATION", "Mandatory data entry", SaveValC)
                Else
                    Cells(Target.Row, 3) = InputBox("Enter data for CLASSIFICATION", "Mandatory data entry")
                End If
                 SaveValC = Cells(Target.Row, 3)
            'Loop
            Application.EnableEvents = True
        End If
    If Cells(Target.Row, 3) = Cells(Target.Row, 2) Then
    Exit Sub
    End If
       
        'Check to see if the item selected has already been saved
    IsColUpdated = False
    If InStr(1, Cells(Target.Row, "F"), Cells(1, Target.Column)) <> 0 Then
        IsColUpdated = True
    End If

    If Not TargetIsEmpty Or IsColUpdated Then
        EditCDEinF Target
    Else
        CDEtoF Target
    End If
    End If
'********************************** End Check for Column E ************************************************

'***************************** Column G Start for inputs of objects *********************************
If Not Intersect(Target, Range("G1:G600")) Is Nothing Then
        If Cells(Target.Row, 7) = "Y" Then
            '-- user selects the object to be embedded
            Set fd = Application.FileDialog(msoFileDialogFilePicker)
            fd.AllowMultiSelect = False
            fd.Filters.Clear
            fd.Filters.Add "Everything", "*.*"
            fd.Filters.Add "Image files", "*.jpg;*.jpeg"
            fd.Filters.Add "TBI files", "*.TBI"
            fd.Show
           
            '-- bail out if nothing selected
            If fd.SelectedItems.Count < 1 Then Exit Sub
           
            '-- insert link to object on hidden sheet
            For Each item In fd.SelectedItems
               
                '-- remove objects existing in the target cell
                For Each Obj In Worksheets("ObjectSheet").OLEObjects
                    If Obj.TopLeftCell.Address = Target.Address Then Obj.Delete
                Next Obj
               
                '-- embed the selected item
                Set Obj = Worksheets("ObjectSheet").OLEObjects.Add(Filename:=item, displayasicon:=True, iconfilename:=item, iconlabel:="OBJECT", iconindex:=0)
                Obj.Left = Worksheets("ObjectSheet").Range(Target.Address).Left
                Obj.Top = Worksheets("ObjectSheet").Range(Target.Address).Top
                Obj.Width = Worksheets("ObjectSheet").Range(Target.Address).Width
                Obj.Height = Worksheets("ObjectSheet").Range(Target.Address).Height
               
                '-- link to this object
                Target.Hyperlinks.Add Target, "", Target.Address, , "LINK"
                 
             Next item
           
        End If
       
    End If

'***************************** End G Column *************************************************

'***************************** Check For J Column *************************************************************
    If Not Intersect(Target, Range("J5:J600")) Is Nothing Then
         'Selected with Other option
        If Cells(Target.Row, 10) = "N" Then
             'require data entry in Justification Cell
            Application.EnableEvents = False
            Do While Cells(Target.Row, 11) = ""
                 'Get data from user
                If SaveVal1 <> "" Then
                    Cells(Target.Row, 11) = InputBox("Enter data for OCA Staff Comments", "Mandatory data entry", SaveVal1)
                Else
                    Cells(Target.Row, 11) = InputBox("Enter data for OCA Staff Comments", "Mandatory data entry")
                End If
                 SaveVal1 = Cells(Target.Row, 11)
            Loop
            Application.EnableEvents = True
        End If
    End If
'********************************** End Check for Column J ************************************************

'********************************** Check For Column K ***************************************************
     'Check for change
    If Not Intersect(Target, Range("K5:K600")) Is Nothing Then
        If Cells(Target.Row, 11) = "" Then
    'MsgBox "Target.Row:" & Target.Row ' to know the target address.
        If Cells(Target.Row, 10) = "N" Then
                    Application.EnableEvents = False
             'require data entry
            Do While Cells(Target.Row, 11) = ""
                 'Get K data from user
                If SaveVal1 = "" Then
                    Cells(Target.Row, 11) = InputBox("Select option in OCA staff Concurrence Requires Data input", "Mandatory data entry", SaveVal1)
                Else
                    Cells(Target.Row, 11) = InputBox("Data Required for Selection in OCA staff Concurrence", "Mandatory data entry")
                End If
               SaveVal1 = Cells(Target.Row, 11)
            Loop
            Application.EnableEvents = True
                Exit Sub
            End If
        End If
    End If
'************************** End Check For Column K ********************************************************
   

End Sub



Then This:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim SaveVal1 As String
Dim Change As Range
If Not Intersect(Target, Range("C1:E600")) Is Nothing Then
For Each Change In Target.Cells
    If Change = "" Then
        TargetIsEmpty = True
    Else
        TargetIsEmpty = False
    End If
Next Change
End If

If Not Intersect(Target, Range("K5:K600")) Is Nothing Then
        If Cells(Target.Row, 11) <> "" Then
            SaveVal1 = Cells(Target.Row, 11)
        End If
End If

End Sub
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim Obj As Object
    If Target.Address = "" And Target.SubAddress <> "" Then
        For Each Obj In Worksheets("ObjectSheet").OLEObjects
            If Obj.TopLeftCell.Address = Target.SubAddress Then Obj.Verb xlPrimary
        Next Obj
    End If

End Sub



Thank You!
0
Amour22015Author Commented:
gowflow

Thank you and Merry Christmas,  I noticed that this posting is getting large so I am going to post what is happening now on part 3
0
gowflowCommented:
I got a B for all this work ???? You were not able to adapt to your solution its not my fault !!! Sorry I am not after points but your evaluation is not fair I gave you exactly what you asked for in this question !!!
gowflow
0
Amour22015Author Commented:
alias99

You are right.  I think gowflow should have received an "A" not a "B".  I just did not know how to change the grade.  It turns out that I was getting errors based on not validating the open workbook.

This workbook gets information from an Access Table, but the problem was(and still is) when the workbook opens it reads all the records in a recordset, not just one record like it should.  Please see:
Access 2007 To Excel 2007

The follow up question is related but not the same question.  Please see:
Excel 2007 Linking Multiple Text Part 3

Thank you!
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.