Lookup text and insert value

[Juriemagic]

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]

can you post as small sample workbook with the 'before' and the 'after'?

[Juriemagic]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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