[VBA] Look for an entry and update an adjacent cell

[Eawyne]

Hi all,

I want to have an inputbox to look for something in a sheet, and when I entered a value in the box, it will add the date to the adjacent cell after getting the focus on it. No need for any action on the cell, just looking for => Date.

I managed to find two codes that do parts of that request, but I'm stuck now, unable to merge them together to get the final result.

This one locates and moves to a cell when finding a value :

Sub Find_First()
    Dim FindString As String
    Dim Rng As Range
    FindString = InputBox("Enter a Search value")
    If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("A:A")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
                
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
End Sub

This one does apply the Date to the cell containing the found value :

Sub Test()

Boite = Application.InputBox("Indiquez la boite à trouver :", "Boite")
   
Set found = Range("A:A").Find(What:=Boite, LookIn:=xlValues, LookAt:=xlWhole)

If found Is Nothing Then
    MsgBox "Cette boite n'existe pas", vbExclamation
    Else
   
    found.Offset(0, 1).Value = Date
 
        End If

End Sub

I tried to find exactly what allows to focus, but I just couldn't. Either articles are related to a specific question and thus hard to decypher, or it's too vague because I lack basics on coding...

What I'm looking for are values like this : R0125 ; I'd like to be able to "wildcard" the search, but again, I've been unable to find a specific item to help me out here.

Thanks for any help given !

 

[sykes]

This should do the trick, for both requirements (no need to make the adjacent cell active).
It assumes that when you say "adjacent cell" you mean next, to the right.
It also appends the adjacent cell, with the date, should there already be any data contained therin.

NB test on a COPY of your work, first:

Sub Find_First()
    Dim FindString As String
    Dim Rng As Range
    FindString = InputBox("Enter a Search value")
    If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("A:A")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
                Rng.Offset(0, 1).Value = Rng.Offset(0, 1).Value & " " & Date
                
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
End Sub

 

[Eawyne]

Thanks for your reply Unfortunately, I'm already on week-end, so I'll only be able to test this out on monday (yeah, I don't even have Excel at home).

Would it be too demanding to ask for a line-by-line explanation of what does what ? Like I said, my skills in coding are almost non-existent, and even if I managed to identify some stuff, it's still rudimentary. One thing I wasn't able to assess, for example, was how to assing a "value" to the Range variable - how to point out to which cell to focus on, without giving a coordinate...

Would you happen to have some suggestion, as well, about which good tutorials to find, or better still, a great book for a total VBA/coding newbie ? ?

 

[sykes]

TBH, I'd rather see if this has achieved the goal first.
For info, I've only added one line to your first procedure. this should go to the cell in question, then append the adjacent one (to the right).

 

[Eawyne]

TBH, I'd rather see if this has achieved the goal first.

Fair enough ! I'll keep you posted.

 

[sykes]

 

[Eawyne]

Hey

works like a charm ; I had forgotten to add that entering the date happens on cells that already have one inside, but I managed to find out what to add to clear the content by looking at your code ^^

Rng.Offset(0, 1).ClearContents

Now I'll try and tinker a button to color-code a cell if the date is older than 90 days =P

So thanks for your help !

 

[sykes]

Hi
Good news! Glad I could help, and thanks for the feedback.

Now that we know that the adjacent cells which need changing already have a date inside, you shouldn't need to clear the contents first - just overwrite the extant date with the new one, all in one fell swoop!

Rng.Offset(0, 1).Value =  Date

...and in order to color-code cell's with dates older than 90 days, I'd be inclined to stick with the simple things, and use Conditional formatting for this.
Loads of info on it here, if you do a search.
Conditional formatting's a very powerful tool, and will be perfect (and straight forward) to implement, in this case.

All the best.

Sykes.

 

[Eawyne]

So, I've been lurking around for the options I needed : colouring a cell, sorting the column. By seeking out articles, I managed to rewrite something that works - when applied indepentantly.

Here's what I have :

Sub Couleurs()

  Dim MyRange As Range
  Set MyRange = Worksheets("Liste des masks").Range("B3:B200")

  For Each cell In MyRange
  If cell.Value < Date - 30 Then
cell.Interior.ColorIndex = 6

  Else
cell.Interior.ColorIndex = xlNone

  End If
  Next

End Sub

I initially put it in the sheet's code, not as a module, but it appeared that you still needed to do another action to make the change effective so I tried to put it in the existing module. And that's when it decided not to work anymore. The code freaked out on Ifs missing Ends, and Withs and Ends... I managed to put it all in sequence so as to not have any errors, but then it simply didn't work.

I also wanted to have an auto-sort :

Sub Sort()

Worksheets("Liste des masks").Sort.SortFields.Clear

Range("B:B").Sort Key1:=Range("B3"), Header:=xlYes, Order1:=xlDescending

End Sub

It also works on its own, but not anymore when I try to include it with the existing macro...

I'm basically stuck with a similar block as before ^^' I could have the colouring coded into the sheet, but I actually wanted to figure out how to do it anyway !

 

[Eawyne]

This code also works well, actually :

Sub testdate()

Cells.Sort Key1:=[B:B], Order1:=xlDescending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

End Sub

The previous one I had written, for whatever reason, changed the date of the last entry Lacking basic understanding really doesn't help ^^'