PDA

View Full Version : Lookup text and insert value



Juriemagic
06-08-2015, 07:58 AM
Hi good people!,

We have two hotels on site, the one is called "Stay Easy", the other "The Ridge". Information for "Stay Easy" resides in range B3:AT137, and "The Ridge" in range CR3:EJ43. This is on sheet "Database". On sheet "Update Rooms" I have 2 drop downs. I would like to have the following, please: If B3 reads "Stay Easy" and F3 reads "text" (This can be anything), I would like VBA to lookup the word in Range B2:AT2 on the "database" sheet, and when it finds it, it must insert the value "2" in that column, starting in row 3 to row 137. The same must apply for if B3 reads "The Ridge", it must find the text value as displayed in F3, in the "database" sheet in range CR2:EJ2, and insert the value "2" in the rest of the column starting at row 3 to row 43. IMPORTANT: Before anything is done, as soon as the value in F3 is text (normally this would be a number), so, VBA recognizes this as text, it must first display a "warning box", prompting "All values for this item will be over written!", Then the user must select "continue" or "cancel". In the case of "continue", all the above executes, otherwise nothing happens. So only when the change happens in F3, AND it is text, must this warning pop up. This might be a lengthy code, I don't know, but as usual, I would like to emphasize that all and any help with this will be accepted with GREAT humility, respect and appreciation. Thank you all very much..

Paul_Hossler
06-08-2015, 08:49 AM
can you post as small sample workbook with the 'before' and the 'after'?

Juriemagic
06-09-2015, 01:52 AM
I guess I can. However, I am scared of doing that simply because Websense detects attachments if sent, and suddenly blocks my user form logging in again. I have already lost access to the Excel Help Forum, and would hate loosing this site also. Is there not anything else I can do for you to assist in understanding my problem?. If not, I guess I will have to take that chance, although I really would appreciate if we can avoid that...

Juriemagic
06-09-2015, 05:47 AM
Hi Paul_Hossler,

I have in the meantime sorted the population of the 2's. I do have a code that hiders columns and also inserts text, so I modified the code to also now insert 2's. My problem is that the code works nicely when it runs alone, but I want it merged with the other code as well. I have tried various things, keep getting all sorts of errors, so if you could just help me out to merge these 2 codes, I will be happy..

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cell As Range, NARange As Range
Set Target = Intersect(Target, Target.Parent.Rows(2))
If Not Target Is Nothing Then
For Each Cell In Target
If Cell.Value = 0 Then
Cell.EntireColumn.Hidden = True
Set NARange = Intersect(Cell.EntireColumn, Range("B3:AT137,CR3:EJ43"))
If Not NARange Is Nothing Then NARange.Formula = "na()"
Else
Cell.EntireColumn.Hidden = False
End If
Next Cell
End If
End Sub


[CODE]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cell As Range, NARange As Range
Set Target = Intersect(Target, Target.Parent.Rows(2))
If Not Target Is Nothing Then
For Each Cell In Target
If Cell.Value = Range("AV1").Value Then
Set TwoRange = Intersect(Cell.EntireColumn, Range("B3:AT137,CR3:EJ43"))
If Not twoRange Is Nothing Then TwoRange.Value = 2
Else
'Do Nothing
End If
Next Cell
End If
End Sub
[CODE]

mperrah
06-09-2015, 08:32 AM
With out an idea of your data layout its hard to test, but this I believe combines you 2 codes

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cell As Range, NARange As Range
Set Target = Intersect(Target, Target.Parent.Rows(2))
If Not Target Is Nothing Then
For Each Cell In Target
If Cell.Value = 0 Then
Cell.EntireColumn.Hidden = True
Set NARange = Intersect(Cell.EntireColumn, Range("B3:AT137,CR3:EJ43"))
If Not NARange Is Nothing Then NARange.Formula = "na()"
ElseIf Cell.Value = Range("AV1").Value Then
Set TwoRange = Intersect(Cell.EntireColumn, Range("B3:AT137,CR3:EJ43"))
If Not TwoRange Is Nothing Then TwoRange.Value = 2
Cell.EntireColumn.Hidden = False
End If
Next Cell
End If
End Sub

Juriemagic
06-09-2015, 11:49 PM
I do thank you, however the coding fails with the following: Un-hiding columns when value is not 0, failing to insert the "2"..I will also work on this myself and search and try to amend to work, and should I find the solution I will let you know, but please, if you don't mind, see if you could also crack this one?..I might end up not getting the fix myself, so I will still be at your "mercy"... :-)

Juriemagic
06-10-2015, 12:07 AM
mperrah,

I have realized the reason for the failures, which is that those cells in row 2 must be selected. as soon as I manually select the range affected in row 2, the columns un-hide, and the "2"'s go in. I think I might be okay for now, I will work on this now, and should I be at a dead end again later on, I will create a new thread under different heading. Thank you for your time, it is highly appreciated.

Juriemagic
06-10-2015, 04:11 AM
mperrah,

Okay, I have no joy, I really tried all I could. The merged code does not work properly, so I was thinking...I know sometimes I shouldn't.. :-), but since the merging poses a problem I was thinking to keep the 2 codes seperate, use the one in the database sheet (for hiding/un-hiding columns), and the other in the "update rooms" sheet. so when the circumstances in this sheet meets requirements, it activates the datasheet and perform the coding. However this is not working as well...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("F1")) Is Nothing Then
Dim answer As Integer
answer = MsgBox("Data For " & Range("F3") & " Will Be Over-Written!", vbOKCancel + vbCritical, "Attention!")
If answer = vbOK Then
Sheets("Database").Activate
Dim Cell As Range, TwoRange As Range
Set Target = Intersect(Target, Target.Parent.Rows(2))
If Not Target Is Nothing Then
For Each Cell In Target
If Cell.Value = Range("F1").Value Then
Set TwoRange = Intersect(Cell.EntireColumn, Range("A3:E15,G3:K7"))
If Not TwoRange Is Nothing Then TwoRange.Value = 2
Else
'Do Nothing
End If
Next Cell
End If
End If
End If
End Sub



Please help me, I am honestly stuck...

mperrah
06-10-2015, 06:20 AM
The codes are in a selection change event. If you aren't selecting anything the code won't fire, you an alter them to on change event might help

Juriemagic
06-11-2015, 01:01 AM
Good day mperrah,

Sorry to bother you again. To answer post #9, AV1 changes as result of a formula. I have tried the change event but then nothing happens at all. What I have realized though is that the reason the columns do not un-hide when there headings change from 0 to text, is because the condition is that Cell.Value must equal AV1. If I deliberately change AV1 to the "new" text heading, the column un-hides. The issue is that "column hidden = false" must not be part of the "Elseif Cell.Value = Range("AV1").Value Then" statement, since the un-hiding of the column has nothing to do with AV1, but purely whether the heading for that column is not 0. The AV1 part has ONLY to do with the 2's. I have tried inserting another Else above "Elseif Cell.Value = Range("AV1").Value Then" with "Cell.EntireColumn.Hidden = False", but I get errors. (Next without For).I really am not able to make the correct changes. Would you please be so kind to see if you can assist me?..

Paul_Hossler
06-11-2015, 05:55 AM
1. Again, it would be most helpful if you could provide a small sample workbook. Even if the cell references are not the real ones (e.g. D1 instead of AV1) we could work out the concepts and them you only need to fiddle with the real addresses

2. As a possible though, this sub "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" should be on the code sheet that expected the change.

Juriemagic
06-11-2015, 06:44 AM
The file upload manager fails to upload the file. I have change it to 14kb so I don't think it's the file size. It's okay, Paul...thanx anyways..

Juriemagic
06-11-2015, 07:41 AM
Finally got it uploaded. Ok, well, the code is the code as is in post #5. AV1 now is A1. I removed a macro button (blue button), from this sheet. It was because of this button that the upload failed. Anyways, the macro was just to select A2:J2. All we can do now is manually select the row and then things must happen. Please see if you can help..If you don't hear from me again, it's because websense blocked me, otherwise you WILL hear from me..thanx a lot Paul..

mperrah
06-11-2015, 08:36 AM
You can try this,
the trick is each letter in Row 2 has to be unique,
if you change A1 to b for example, all columns with b in row 2 would get the "2"
but if each is unique, this do what you have asked, by just changing A1 value and hit enter or arrow of A1
Changing the row 2 value to any number will hide it and using the address bar to locate and replace the value with a letter unhides it now.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cell As Range, NARange As Range
Set Target = Range("A1")
If Not Target Is Nothing Then
For x = 1 To 10
If IsNumeric(Cells(2, x)) Then
Cells(2, x).EntireColumn.Hidden = True
Set NARange = Intersect((Cells(2, x).EntireColumn), Range("A3:E15,F3:J7"))
If Not NARange Is Nothing Then NARange.Formula = "na()"
ElseIf Cells(2, x).Value = Range("A1").Value Then
Set TwoRange = Intersect((Cells(2, x).EntireColumn), Range("A3:E15,F3:J7"))
If Not TwoRange Is Nothing Then TwoRange.Value = 2
Cells(2, x).EntireColumn.Hidden = False
End If
Next x
End If
End Sub


hope this helps
-mark

Paul_Hossler
06-11-2015, 10:04 AM
I think you're looking for something like this




Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rCell As Range, rNA As Range, rTwo As Range, rTarget As Range

If Target.Cells(1, 1).Address = "$A$1" Then
Range("A1").CurrentRegion.EntireColumn.Hidden = False
Set rTarget = Intersect(Target.Parent.Rows(2), Target.Parent.UsedRange)
Else
Set rTarget = Intersect(Target.Cells(1, 1), Target.Parent.Rows(2))
If rTarget Is Nothing Then Exit Sub
End If


Application.EnableEvents = False
For Each rCell In rTarget
If Len(rCell.Value) > 0 And rCell.Value = 0 Then
rCell.EntireColumn.Hidden = True
Set rNA = Intersect(rCell.EntireColumn, Range("A3:E15,F3:J7"))
If Not rNA Is Nothing Then rNA.Formula = "=na()"
ElseIf rCell.Value = Range("A1").Value Then
Set rTwo = Intersect(rCell.EntireColumn, Range("A3:E15,F3:J7"))
If Not rTwo Is Nothing Then rTwo.Value = 2
rCell.EntireColumn.Hidden = False
End If
Next
Application.EnableEvents = True

End Sub

Juriemagic
06-14-2015, 11:30 PM
Hallo Paul,

Okay, the hiding of the columns and the input of "NA", works fine. The 2's are working fine when column is un-hidden, BUT, the condition for the column to be un-hidden is still based on the value of A1. It should un-hide whenever the 0 becomes text, regardless of the value of A1. Otherwise all works fine. I will also work on your code and see where it can be altered. Thank you for your time spent on this so far, you have been a great help!

Juriemagic
06-14-2015, 11:34 PM
mperrah,

thanx for your code as well. The hiding part, the "na" part and the "2" part all works great, it's just the un-hiding of the columns which also is still dependent on the value in A1. The columns should un-hide regardless of A1 value. I will also play with your code and see if I can alter it to suit my needs. Thank you also for your time spent on this, it is really appreciated!

Juriemagic
06-15-2015, 01:28 AM
Paul and ,mperrah,

I have now considered something else:..to try and make things easier.. I am going with the first code of post #4 to do the un-hiding and NA part. I'm happy with that. Just wondering how to slightly change the second code (post #4) to work in a normal macro. There are 2 possible scenarios: The first is to have one button to perform both ranges OR two buttons to perform one range each. So, once the columns are un-hidden, if I click a button, it searches the text in AV1, to find it in row 2. Once found, it inserts the 2's. Maybe this will be an easier approach. In the meantime I am looking also, and should I find a solution, I will let you know..In the meantime, thank you both once again, really you are a great help!

mperrah
06-15-2015, 10:22 AM
is this closer?
Im curious, how do you plan to change the value in a hidden cell other than via the address bar?
You can use indirect in a cell like A1 or AV1 and have target the hidden row in order to enter a text value.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cell As Range, NARange As Range
Set Target = Intersect(Target, Target.Parent.Rows(2))
If Not Target Is Nothing Then
For Each Cell In Target
If Cell.Value = 0 Then
Cell.EntireColumn.Hidden = True
Set NARange = Intersect(Cell.EntireColumn, Range("B3:AT137,CR3:EJ43"))
If Not NARange Is Nothing Then NARange.Formula = "na()"
ElseIf Not IsNumeric(Cell.Value) Then
Set TwoRange = Intersect(Cell.EntireColumn, Range("B3:AT137,CR3:EJ43"))
If Not TwoRange Is Nothing Then TwoRange.Value = 2
Cell.EntireColumn.Hidden = False
End If
Next Cell
End If
End Sub

mperrah
06-15-2015, 03:47 PM
This can be put in a standard module and ran with the cell selected you want to hide or add

Sub hideColumnsWithNum()
Dim Cell As Range, NARange As Range
Set Target = Intersect(ActiveCell, ActiveCell.Parent.Rows(2))
If Not Target Is Nothing Then
For Each Cell In Target
If Cell.Value = 0 Then
Cell.EntireColumn.Hidden = True
Set NARange = Intersect(Cell.EntireColumn, Range("B3:AT137,CR3:EJ43"))
If Not NARange Is Nothing Then NARange.Formula = "na()"
End If
Next Cell
End If
End Sub
Sub unhideColumnsWithText()
Dim Cell As Range, NARange As Range
Set Target = Intersect(ActiveCell, ActiveCell.Parent.Rows(2))
If Not Target Is Nothing Then
For Each Cell In Target
If Not IsNumeric(Cell.Value) Then
Set TwoRange = Intersect(Cell.EntireColumn, Range("B3:AT137,CR3:EJ43"))
If Not TwoRange Is Nothing Then TwoRange.Value = 2
Cell.EntireColumn.Hidden = False
End If
Next Cell
End If
End Sub

mperrah
06-15-2015, 03:56 PM
And this can find the Row 2 value of "0" and replace with "X" and add in 2's (needs to be selected first)


Sub unhideColumnsWith0AddX()
Dim Cell As Range, NARange As Range
Set Target = Intersect(ActiveCell, ActiveCell.Parent.Rows(2))
If Not Target Is Nothing Then
For Each Cell In Target
If Cell.Value = 0 Then
Cell.Value = "X"
Set TwoRange = Intersect(Cell.EntireColumn, Range("B3:AT137,CR3:EJ43"))
If Not TwoRange Is Nothing Then TwoRange.Value = 2
Cell.EntireColumn.Hidden = False
End If
Next Cell
End If
End Sub

mperrah
06-15-2015, 04:10 PM
This unhides "0" columns without selecting first, I think this should do it for you.

Sub unhideColumnsWith0AddX()
Dim x As Long
Dim TwoRange As Range

For x = 1 To 8
If Cells(2, x).Value = 0 Then
Cells(2, x).Value = "X"
Set TwoRange = Intersect(Cells(2, x).EntireColumn, Range("B3:AT137,CR3:EJ43"))
If Not TwoRange Is Nothing Then TwoRange.Value = 2
Cells(2, x).EntireColumn.Hidden = False
End If
Next x

End Sub

Juriemagic
06-17-2015, 03:16 AM
Okay, your code in post 19 misses the AV1 part now. You see, the AV1 part plays a role in the inserting of the 2's only. The column of which the header matches the text in AV1, must change to 2's. That was working fine, what I had a problem with was the UN-HIDING only. (post 17) As soon as a header changed from 0 to text, that specific column would not un-hide. with the code above, all text header's columns are now going to change to 2's...

Juriemagic
06-17-2015, 03:19 AM
Oh, to answer your question..the cells in row 2 are formulas referencing other cells in another worksheet. so its, "=UPDATE ROOMS!H14", for example.

Juriemagic
06-17-2015, 03:36 AM
mperrah,

We can leave the top part of the code as that part resides in the sheet module. I have copied and pasted the second part and put that into a macro button. I have changed the "isnumeric" part because the inserting of the 2's are dependent on the value in AV1. However the code does nothing when I click the button, so I'm very sure I altered the piece of code incorrectly. If this can be sorted, we'll be home..please..

Dim Cell As Range, NARange As Range
Set Target = Intersect(ActiveCell, ActiveCell.Parent.Rows(2))
If Not Target Is Nothing Then
For Each Cell In Target
If (Cell.Value) = Range("AV1").Value Then
Set TwoRange = Intersect(Cell.EntireColumn, Range("B3:AT137,CR3:EJ43"))
If Not TwoRange Is Nothing Then TwoRange.Value = 2
Cell.EntireColumn.Hidden = False
End If
Next Cell
End If
End Sub

Juriemagic
06-17-2015, 05:30 AM
mperrah,

post 22 did it!!!. I changed the code slightly to work properly for my needs. Excellent work!. Thank you very much, really, you have been patient, I have to say. Just for kicks, the code as it is now:
Dim x As Long
Dim TwoRange As Range

For x = 1 To 150
If Cells(3, x).Value = Range("F1").Value Then
Set TwoRange = Intersect(Cells(3, x).EntireColumn, Range("B4:AT138,CR4:EJ44"))
If Not TwoRange Is Nothing Then TwoRange.Value = 2

End If
Next x

mperrah
06-17-2015, 06:44 AM
Nice, glad we got it. Any of these codes can be a macro assigned to a button if you prefer, they can even be adapted to fire when a specific cell is selected so buttons aren't needed
using the code I made with target and active cell choose the cell you want to fire the code, then use the for x = 1 to 150 to find the value of AV1.
But if you happy with these working so am I.
Cheers

mperrah
06-17-2015, 08:48 AM
With this you have the value in A1 be what you want add 2's then select "B1" (it will do all matches of A1)
To unhide a row type na() in A1 then select B1
to hide a row type "0" in the row you want to hide then select "B1"


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ActionCell As Range

Set ActionCellShow = Range("B1")

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, ActionCellShow) Is Nothing Then
For x = 1 To 150
If Cells(3, x).Value = Range("A1") Then
Set TwoRange = Intersect(Cells(2, x).EntireColumn, Range("A3:AT137,CR3:EJ43"))
If Not TwoRange Is Nothing Then TwoRange.Value = 2
Cells(2, x).EntireColumn.Hidden = False
ElseIf Cells(2, x).Value = "0" Then
Cells(2, x).EntireColumn.Hidden = True
Set NARange = Intersect(Cells(2, x).EntireColumn, Range("A3:AT137,CR3:EJ43"))
If Not NARange Is Nothing Then NARange.Formula = "na()"
ElseIf Cells(2, x).Value = Range("A1") Then
Set TwoRange = Intersect(Cells(2, x).EntireColumn, Range("A3:AT137,CR3:EJ43"))
If Not TwoRange Is Nothing Then TwoRange.Value = 2
Cells(2, x).EntireColumn.Hidden = False
End If
Next x
End If
End Sub

Juriemagic
06-17-2015, 10:38 PM
Thanx mperrah,

will keep this one in mind, one never knows if one would need it sometime!. Have a blessed day!

SamT
06-18-2015, 06:09 AM
@ all,

Avoid using an Event sub to hold your code. Placing your code in the Event sub can prevent you from ever using that Event for any other purpose.

Use the Event sub to determine the target and what procedure to run.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$A$1" Then Call ActionA1

If Intersect(Target, Columns(3)) Then Call Module1.Action2
End sub

Sub Action1()
'Blah, Blah
End Sub

Sub Action2)
'Bleh, bleh
End Sub

Juriemagic
06-18-2015, 06:22 AM
Thank you SamT, worth considering. Should I ran into such a scenario as described, I will certainly come back to this code. Thanx a lot..

mperrah
06-18-2015, 08:37 AM
in the sheet 1 code:


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$A$2" Then
Call if_A1_add2
ElseIf Target.Address = "$A$3" Then
Call if_0
ElseIf Target.Address = "$A$4" Then
Call if_Na
End If
End Sub

in a module:


Sub if_A1_add2()
Dim TwoRng As Range

For x = 2 To 150
If Cells(2, x).Value = Range("A1") Then
Set TwoRng = Intersect(Cells(2, x).EntireColumn, Range("B3:AT137,CR3:EJ43"))
If Not TwoRng Is Nothing Then TwoRng.Value = 2
Cells(2, x).EntireColumn.Hidden = False
End If
Next x
End Sub
Sub if_0()
Dim TwoRng, NaRng As Range

For x = 2 To 150
If Cells(2, x).Value = "0" Then
Cells(2, x).EntireColumn.Hidden = True
Set NaRng = Intersect(Cells(2, x).EntireColumn, Range("B3:AT137,CR3:EJ43"))
If Not NaRng Is Nothing Then NaRng.Formula = "na()"

End If
Next x
End Sub
Sub if_Na()
Dim TwoRng As Range

For x = 2 To 150
If Cells(3, x).Value = "na()" Then
Set TwoRng = Intersect(Cells(2, x).EntireColumn, Range("B3:AT137,CR3:EJ43"))
Cells(2, x).EntireColumn.Hidden = False

End If
Next x
End Sub
on the sheet1 move the cells to right 1 column and:
in A2 put "add2"
in A3 put "Hide 0"
in A4 put "Show na"

in A1 put a letter (a to e) and select A2, that matching column will get 2's (multiple matches will all get 2's)
change a row 2 letter to "0" and select A3, that column will get "na()" and hide
select A4, the columns with "na()" will unhide

SamT
06-18-2015, 09:28 AM
Lay out your worksheet like in the attached, Using the suggestions below, select a yellow cell, then doubleclick on one of the grey cells. I forgot to put exit sub if Add2Value = "" in the if_A1add2 sub. which using this style you will want to change all the sub names anyway.

Use the top five rows of the attached for various things as you desire.

In Module with Code, Declare Module Level Variable"

Dim Add2Value As String
On Sheet Code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Range("A1:E1") Is Nothing Then
If Target.Count > 1 Then Exit Sub
Add2Value = Target.Value
Else: Add2Vaule = ""
End If

'Different Selection check
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("A2:E2") Is Nothing then
Cancel = True
If Target.Address = "$A$2" Then
Call if_A1_add2
ElseIf Target.Address = "$C$2" Then
Call if_0
ElseIf Target.Address = "$E$2" Then
Call if_Na
End If
End If

'More Double Click code
End Sub

Edit this sub

Sub if_A1_add2()
Dim TwoRng As Range

For x = 2 To 150
If Cells(2, x).Value = Add2Value Then
'
'
'
End Sub

I think you will find that all the subs will run faster if you use a Find...FindNext loop

ps: Put a comment in A2 telling people to select a yellow cell first.

pps: you don;t need the KeyWord "Call." I only use it (like a comment) when teaching.

mperrah
06-18-2015, 03:24 PM
13731
I moved some code to and from the worksheet page
and updated the functionality with drop down values and comments.
I made a second sheet with room names and the values to be in room Columns
and named the columns dynamically so if more are added they will be incorporated.

you can update the "A1 and B1" values with drop downs then select Add or Hide.
Or after picking the drop down values you can double click A2, A3 or A4 for same effects.
you can pretty much pick the combination of what you want and it does it.
ie: room c add na(), or room b2 add 2, room c unhide na() etc.

Is this more of what you suggested SamT?
I tried the unhide using find, but it did not seem to work on hidden columns.
find does work on the hide portion.

Thank you

mperrah
06-18-2015, 03:27 PM
I couldn't use the Add2Value as target because I'm not selecting the cell with the values,
its all based on the values in the drop downs of A1 (room) and A2 (value to put in room) while selecting C1 or D1
or double clicking A2, A3 or A4