Condition if Cell contains anything then write formula

I

Infine

Board Regular
Joined
Oct 16, 2019
Messages
93
Office Version
  1. 365
Platform
  1. Windows
Hello,

I want to be able to write out this function: "=VLOOKUP(D2;Databas!$A$2:$O$1048576;8;FALSE)" (which will automatically change "D2 to D3, D4 etc depending on which cell you write in on D)


So if D2 contains ANYTHING I want "=VLOOKUP(D2;Databas!$A$2:$O$1048576;8;FALSE)" be typed next to it (on E2). If it does not contain anything, I want E2 be empty. Is this possible? Can I put this through some Rule?

If D3 contains ANYTHING I want "=VLOOKUP(D3;Databas!$A$2:$O$1048576;8;FALSE)" be typed next to it (on E3) etc.

Appreciate all help.
 
Sort by date Sort by votes
EFANYoutube said:
Infine
The Vba Above runs very quick (as in no one would evein know its running and if a cell is changed that is not in "D" column, the code does nothing
Up to you but seems the best solution
Click to expand...
I am not able to run the Sub function... Would appreciate if I could get further help as I am not a pro (yet) with functions on VBA.


I am understanding this as:

Private Sub Worksheet_Change(ByVal Target As Range) - This seem to not work as I am not even able to run the Sub.
If Target.Column = 4 Then - If D is empty, then nothing else type the formula. However, I want the formula to be written in another Target.
If Target = "" Then
Target.Offset(, 1) = ""
Else
Target.Offset(, 1).Formula = "=VLOOKUP(" & Target.Address(0, 0) & ",Databas!$A$2:$O$1048576,8,FALSE)"
I want to add more stuff here, like A2 write "TODAY() date" etc
End If
End If
End Sub
 
Last edited:
Upvote 0

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column = 4 Then
ThisRow = Target.Row
If Target.Value <> 0 Then
Range("A" & ThisRow).Value = Date
Else
Range("A" & ThisRow).Interior.ColorIndex = xlColorIndexNone
End If
End If
End Sub


This worked. I figure out how the script works and it is exactly what I am looking for. Thanks man!
 
Upvote 0
Infine said:
I am not able to run the Sub function... Would appreciate if I could get further help as I am not a pro (yet) with functions on VBA.


I am understanding this as:

Private Sub Worksheet_Change(ByVal Target As Range) - This seem to not work as I am not even able to run the Sub.
If Target.Column = 4 Then - If D is empty, then nothing else type the formula. However, I want the formula to be written in another Target.
If Target = "" Then
Target.Offset(, 1) = ""
Else
Target.Offset(, 1).Formula = "=VLOOKUP(" & Target.Address(0, 0) & ",Databas!$A$2:$O$1048576,8,FALSE)"
I want to add more stuff here, like A2 write "TODAY() date" etc
End If
End If
End Sub
Click to expand...
This needs to go into the sheet module, Right click on the sheet tab and click View Code
Then delete everything in there and paste the below code
Now every time someone writes something in a cell the code will run
If someone write in a column that is not D, the code will not do anything
But if it is D then it will write the correct formula in the E column of the same row the data was added


Private Sub Worksheet_Change(ByVal Target As Range) '- This seem to not work as I am not even able to run the Sub. see above
If Target.Column = 4 Then 'if the cell is D then
If Target = "" Then ' if the data was deleted then
Target.Offset(, 1) = "" ' remove the formula in E column of same row
Target.Offset(, -3) = "" ' remove the formula in A column of same row
Else
Target.Offset(, 1).Formula = "=VLOOKUP(" & Target.Address(0, 0) & ",Databas!$A$2:$O$1048576,8,FALSE)" ' add formula
Target.Offset(, -3).Formula = "=TODAY()" 'Add formula
'I want to add more stuff here, like A2 write "TODAY() date" etc
End If
End If
End Sub

I have tested it and it does what it says on the box

Thanks
Excel Fan
 
Upvote 0
Hello again,

Excuse me for so many posts.

I have figure out to make it work as well. However, a major issue. If I paste several rows in D I get Debug.

This is the code I use and I would like to remove one of the IF and make the first understand Target 4 +1. If not, then it's fine to use this. Can I also make this run faster as it runs very slow?



VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 4 Then
        If Target = "" Then
            Target.Offset(, 1) = ""
        Else
            Target.Offset(, 1).Formula = "=VLOOKUP(" & Target.Address(1, 0) & ",Databas!$A$2:$O$1048576,8,FALSE)"
            Target.Offset(, 2).Formula = "=VLOOKUP(" & Target.Address(1, 0) & ",Databas!$A$2:$O$1048576,12,FALSE)"

            Target.Offset(, -3).Value = Date
        End If
    End If
  
    If Target.Column = 5 Then
  
         If Target = "" Then
            Target.Offset(, 1) = ""
        Else
            Target.Offset(, 2).Formula = "=VLOOKUP(" & Target.Address(1, 0) & ",Kontonummer!$A$2:$O$1048576,3,FALSE)"
        End If
    End If
 
  
End Sub



If I change the codes, by removing some IF statements I can remove the debug.


VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 4 Then
        

            Target.Offset(, 1).Formula = "=VLOOKUP(" & Target.Address(1, 0) & ",Databas!$A$2:$O$1048576,8,FALSE)"
            Target.Offset(, 2).Formula = "=VLOOKUP(" & Target.Address(1, 0) & ",Databas!$A$2:$O$1048576,12,FALSE)"

            Target.Offset(, -3).Value = Date
       
    End If
    
    If Target.Column = 5 Then
    
              Target.Offset(, 2).Formula = "=VLOOKUP(" & Target.Address(1, 0) & ",Kontonummer!$A$2:$O$1048576,3,FALSE)"
   
    End If
   
    
End Sub
 
Upvote 0
Sorry didn't realise you were going to do more than 1 cell at a time

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range) '- This seem to not work as I am not even able to run the Sub. see above
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    If Target.Column = 4 Then 'if the cell is D then

        For Each cell In Target.Cells
            If cell = "" Then  ' if the data was deleted then
    
                cell.Offset(, 1) = "" ' remove the formula in E column of same row
    
                cell.Offset(, -3) = "" ' remove the formula in A column of same row
    
            Else
    
                cell.Offset(, 1).Formula = "=VLOOKUP(" & cell.Address(0, 0) & ",Databas!$A$2:$O$1048576,8,FALSE)" ' add formula
    
                cell.Offset(, -3).Formula = "=TODAY()" 'Add formula
    
    'I want to add more stuff here, like A2 write "TODAY() date" etc
    
            End If
        Next cell
    End If
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
 
Upvote 0
Solution
Okey this works almost perfect.

I have a major issue though :((((((((


I can't CTRL + Z after writing something in a row.... This could be crucial as if you accidently replace something that has already been written and have no idea what is was, you can't regret it.

Do we have any solution for this major issue? If we do then this is PERFECT.



This is the code now:


VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range) '- This seem to not work as I am not even able to run the Sub. see above
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    If Target.Column = 4 Then 'if the cell is D then

        For Each cell In Target.Cells
            If cell = "" Then  ' if the data was deleted then
    
                cell.Offset(, 1) = "" ' remove the formula in E column of same row
                cell.Offset(, 2) = "" ' remove the formula in E column of same row
    
                cell.Offset(, -3) = "" ' remove the formula in A column of same row
    
            Else
    
                cell.Offset(, 1).Formula = "=VLOOKUP(" & cell.Address(1, 0) & ",Databas!$A$2:$O$1048576,8,FALSE)"
                cell.Offset(, 2).Formula = "=VLOOKUP(" & cell.Address(1, 0) & ",Databas!$A$2:$O$1048576,12,FALSE)"
    
               
                cell.Offset(, -3).Value = Date
    
  
    
            End If
        Next cell
    End If
    
 If Target.Column = 5 Then 'if the cell is D then

        For Each cell In Target.Cells
            If cell = "" Then  ' if the data was deleted then
    
                cell.Offset(, 2) = "" ' remove the formula in E column of same row
    
      
    
            Else
    
                cell.Offset(, 2).Formula = "=VLOOKUP(" & cell.Address(1, 0) & ",Kontonummer!$A$2:$O$1048576,3,FALSE)"
             
                   
    
            End If
        Next cell
    End If
    
    
    
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
 
Upvote 0
I do understand what you mean. VBA code when it is run deletes the undo list
The only way to do this is to save in memory, a list of changes made and add an item to the Application.undo
Alas I haven't done this before but it is doable

Preserving the Undo List (Microsoft Excel)

The undo list can be a lifesaver when working in a macro. Unfortunately, the undo list is not preserved when you run a macro. Here are some ideas on how you can "undo" any changes that might be introduced by your macro. (Tips.Net)
excel.tips.net excel.tips.net
 
Upvote 0
Hmmm this is not optimal. I might only use this script for the Date and the rest we must drag...

Thank you anyways, I learned something new! I appreciate this.
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
VBA set conditional formatting application-defined or object-defined error
Replies
3
Views
78
Cubist
Cubist
T
  • Solved
Challenge Question: A Quest for Elegance
Replies
6
Views
282
Peter_SSs
Peter_SSs
W
  • Solved
VBA Apply Formatting Based on 2 Criteria and If Another Cell Contains...
2
Replies
13
Views
256
Joe4
Joe4
J
  • Solved
If(vlookup or formula
Replies
2
Views
165
Jon3sy
J
S
  • Solved
IF Statements Trouble
2
Replies
11
Views
491
StephenCrump
S

Forum statistics

Threads
1,214,984
Messages
6,122,601
Members
449,089
Latest member
Motoracer88

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top