PDA

View Full Version : [SOLVED] Simplify Code?



Nick72310
11-20-2015, 01:39 PM
Is there anyway to simplify my code? Or does anyone know another way to serve the same function?
The purpose of the code is to give each cell a default formula, but still allow the user to do manual entry. So if the user enters data in a cell, it will display the user entry. But if they decide to delete the cell, it goes back to the default formula. Each formula uses the Vlookup function. The challenge is the lookup value, it changes from cell to cell.

Ps. I want this code to cover cells B10:K29. Each with its own lookup value. The column number will also change. (See code for better understanding)
Also, if there is a way to do IFERROR in VBA, that would be ideal.


'Defaults to Vlookup

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next

'Column B10:B29
If IsEmpty(Range("B10").Value) = True Then
Range("B10").Value = "=VLOOKUP($E$10, OIB, 8, 0)"
End If
If IsEmpty(Range("B11").Value) = True Then
Range("B11").Value = "=VLOOKUP($E$11, OIB, 8, 0)"
End If
If IsEmpty(Range("B12").Value) = True Then
Range("B12").Value = "=VLOOKUP($E$12, OIB, 8, 0)"
End If
If IsEmpty(Range("B13").Value) = True Then
Range("B13").Value = "=VLOOKUP($E$13, OIB, 8, 0)"
End If
If IsEmpty(Range("B14").Value) = True Then
Range("B14").Value = "=VLOOKUP($E$14, OIB, 8, 0)"
End If
If IsEmpty(Range("B15").Value) = True Then
Range("B15").Value = "=VLOOKUP($E$15, OIB, 8, 0)"
End If
If IsEmpty(Range("B16").Value) = True Then
Range("B16").Value = "=VLOOKUP($E$16, OIB, 8, 0)"
End If
.
.
.

'Column F10:F29
If IsEmpty(Range("F10").Value) = True Then
Range("F10").Value = "=VLOOKUP($E$10, OIB, 2, 0)"
End If
If IsEmpty(Range("F11").Value) = True Then
Range("F11").Value = "=VLOOKUP($E$11, OIB, 2, 0)"
End If
If IsEmpty(Range("F12").Value) = True Then
Range("F12").Value = "=VLOOKUP($E$12, OIB, 2, 0)"
End If
If IsEmpty(Range("F13").Value) = True Then
Range("F13").Value = "=VLOOKUP($E$13, OIB, 2, 0)"
End If
If IsEmpty(Range("F14").Value) = True Then
Range("F14").Value = "=VLOOKUP($E$14, OIB, 2, 0)"
End If
.
.
.

End Sub

SamT
11-20-2015, 06:54 PM
You will need to turn off ScreenUpdating and set Calculation to Manual during the sub's runtime.

the correct code is Range.Formula = "=Vlookup..." and the Formula String can be any valid Excel Formula

You can use VBA concatenation inside the Formula String

= "=VLOOKUP($E$" & Cell.Row & ", OIB, 8, 0)"


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ReturnCol As Long

On Error GoTo GracefulExit

If Intersect(Target, Range("B10:K29")) Is Nothing Then Exit Sub
If Not Target.Formula = vbNullString Then Exit Sub

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Select Case Target.Column
Case 2: ReturnCol = 8 'Col B
Case 3: 'ReturnCol = ??? 'Col C
Case 4: 'Col D
Case 5: 'Col E
Case 6: ReturnCol = 2 'Vol F
'Case all the way to Column K
End Select

Target.Formula = "=VLOOKUP($E$" & Target.Row & ", OIB, " & ReturnCol & ", 0)"

GracefulExit:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

SamT
11-20-2015, 07:16 PM
Also, if there is a way to do IFERROR in VBA, that would be ideal.
do you mean that if after a Change, the Cell.Value is an Error String? ("N/A", "REF", etc.)

Bob Phillips
11-21-2015, 04:32 AM
the correct code is Range.Formula = "=Vlookup..." ...

No, that is not correct. Whilst .Formula might be better documenting, .Value works perfectly well. Maybe it shouldn't, but it does.


ActiveCell.Value = "=SUM(M1:N20)"

Bob Phillips
11-21-2015, 04:34 AM
do you mean that if after a Change, the Cell.Value is an Error String? ("N/A", "REF", etc.)

I think he means to tidy up the cell value if it is an error, but I would have thought it better to just add IFERROR to the formula.

Nick72310
11-24-2015, 08:46 AM
You are correct, however, VBA does not allow me to add iferror in the formula. For example, this will not work...

If IsEmpty(Range("B10").Value) = True Then
Range("B10").Value = "=IFERROR(VLOOKUP($E$10, OIB, 8, 0),"")"
End If


I think he means to tidy up the cell value if it is an error, but I would have thought it better to just add IFERROR to the formula.

Aflatoon
11-24-2015, 08:58 AM
It will, but you have to double the quotes inside the formula string:


Range("B10").Value = "=IFERROR(VLOOKUP($E$10, OIB, 8, 0),"""")"

p45cal
11-24-2015, 03:39 PM
See if this cuts the mustard:
Private Sub Worksheet_Change(ByVal Target As Range)
Set CellsToCheck = Intersect(Target, Range("B10:K29"))
If Not CellsToCheck Is Nothing Then
Application.EnableEvents = False
On Error Resume Next
For Each colm In Range("B10:K29").Columns
With Intersect(colm, Target)
myFormula = "=IFERROR(VLOOKUP(RC5, OIB," & Choose(colm.Column, 0, 8, 1, 1, 1, 2, 1, 1, 1, 1, 1) & ", 0),"""")"
If .Cells.Count = 1 Then
If IsEmpty(.Cells(1)) Then .FormulaR1C1 = myFormula
Else
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = myFormula
End If
End With
Next colm
On Error GoTo 0
Application.EnableEvents = True
End If
End SubYou'll need to edit the 1s in this bit:
Choose(colm.Column, 0, 8, 1, 1, 1, 2, 1, 1, 1, 1, 1)
Choose(colm.Column, A, B, C, D, E, F, G, H, I, J, K) <<< this is just a guide to which numbers apply to which column, it is not a line of code.
I've already done columns B and F, I don't see a pattern.
I've changed the absolute row reference in each formula to a relative row ref. - I doubt it matters.
This handles block deletes/edits, contiguous or not.

One thing worries me though, empty cells in column E will be looking themselves up!

Nick72310
11-25-2015, 08:37 AM
Thank you for the replies! I ended up going with SamT's solution (second code shown below). It seemed to work the best with the rest of my document because I had a few columns that I never wanted to change and his gave me that opportunity.

One thing I would like to add is UCASE. I would like to automatically uppercase all the user entries. I used to use the code shown below, but it no longer works with worksheet change and the code SamT provided. I do not want this happen when the above code occurs (default cell formula), I only need this when a manual entry happens. (UCASE for cells G4:G6,B9:M28,G31:G39)


'AUTO CAPS
On Error GoTo GracefulExit
If Intersect(Target, Range("G4:G6,B9:M28,G31:G39")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Target = UCASE(Target)
Application.EnableEvents = True


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'DEFAULT CELL
Dim ReturnCol As Long

On Error GoTo GracefulExit
If Intersect(Target, Range("B9:B28,G9:G28,I9:I28,L9:M28")) Is Nothing Then Exit Sub
If Not Target.Formula = vbNullString Then Exit Sub

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Select Case Target.Column
Case 2: ReturnCol = 3
Case 7: ReturnCol = 2
Case 9: ReturnCol = 6
'Case 10: ReturnCol = 7 (Merged Row)
'Case 11: ReturnCol = 7 (Merged Row)
Case 12: ReturnCol = 4
Case 13: ReturnCol = 5
End Select

Target.Formula = "=IFERROR(VLOOKUP($E$" & Target.Row & ", OIB, " & ReturnCol & ", 0),"""")"
GracefulExit:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub

SamT
11-25-2015, 09:30 AM
The two requirements have overlapping ranges, and you can only have one Change Sub per worksheet.

This means you will need to split the decision flows in to several small subs.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim GotFormula As Boolean

If Not Intersect(Target, Range("B9:B28,G9:G28,I9:I28,L9:M28")) Is Nothing Then
If Target.Formula = vbNullString Then
PutFormula Target
GotFormula = True 'Dont MakeUCase
End If
End If

If Not GotFormula Then
If Not Intersect(Target, Range("G4:G6,B9:M28,G31:G39")) Is Nothing Then MakeUCase Target
End If

'If Intersect Some Other Range, then call Other Sub here

End Sub

Private Sub MakeUCase(ByVal Target As Range)
'AUTO CAPS
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True

End Sub

Private Sub PutFormula(ByVal Target As Range)
Dim ReturnCol As Long

On Error GoTo GracefulExit

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Select Case Target.Column
Case 2: ReturnCol = 3
Case 7: ReturnCol = 2
Case 9: ReturnCol = 6
'Case 10: ReturnCol = 7 (Merged Row)
'Case 11: ReturnCol = 7 (Merged Row)
Case 12: ReturnCol = 4
Case 13: ReturnCol = 5
End Select

Target.Formula = "=IFERROR(VLOOKUP($E$" & Target.Row & ", OIB, " & ReturnCol & ", 0),"""")"
GracefulExit:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

p45cal
11-25-2015, 11:27 AM
You may need to test what does/doesn't happen if the user selects more than one cell and edits/deletes, especially if the top left cell is outside the range you want things to happen in, but part of the edited range is inside the range you want things to happen in.

Nick72310
12-01-2015, 12:44 PM
P45cal, you are correct. It will not work when the user selects more than one cell. Any way around that?

Also when I use the code, it changes the cell to the answer and not the formula (Target.Formula = "=IFERROR(VLOOKUP($E$" & Target.Row & ", OIB, " & ReturnCol & ", 0),"""")"). I need the formula in the cell and then the answer just displayed. Or else if the user deletes a cell that has no referenced cell in the formula, it will just display as blank. Any way to fix this too?

The Auto Caps seems to work well though.

p45cal
12-02-2015, 04:39 PM
try something along these lines:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RngToCheckForNonFormulae As Range, RngToCheckForUserInput As Range, cll As Range
On Error GoTo GracefulExit
Set RngToCheckForNonFormulae = Intersect(Target, Range("B9:B28,G9:G28,I9:I28,L9:M28"))
If Not RngToCheckForNonFormulae Is Nothing Then
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
For Each cll In RngToCheckForNonFormulae.Cells
If IsEmpty(cll) Then cll.FormulaR1C1 = "=IFERROR(VLOOKUP(RC5, OIB," & Choose(cll.Column, 0, 3, 0, 0, 0, 0, 2, 0, 6, 0, 0, 4, 5) & ", 0),"""")"
' IsEmpty(cll) Then cll.FormulaR1C1 = "=IFERROR(VLOOKUP(RC5, OIB," & Choose(cll.Column, A, B, C, D, E, F, G, H, I, J, K, L, M) & ", 0),"""")"
Next cll
End If
'AUTO CAPS
Set RngToCheckForUserInput = Intersect(Target, Range("G4:G6,B9:M28,G31:G39"))
If Not RngToCheckForUserInput Is Nothing Then
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
For Each cll In RngToCheckForUserInput.Cells
If Not cll.HasFormula And Len(cll.Value) > 0 Then cll.Value = UCase(cll.Value)
Next cll
End If
GracefulExit:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub

Nick72310
12-03-2015, 07:39 AM
That works great P45cal! Thank You!!!

Thank you SamT for helping too!


try something along these lines:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RngToCheckForNonFormulae As Range, RngToCheckForUserInput As Range, cll As Range
On Error GoTo GracefulExit
Set RngToCheckForNonFormulae = Intersect(Target, Range("B9:B28,G9:G28,I9:I28,L9:M28"))
If Not RngToCheckForNonFormulae Is Nothing Then
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
For Each cll In RngToCheckForNonFormulae.Cells
If IsEmpty(cll) Then cll.FormulaR1C1 = "=IFERROR(VLOOKUP(RC5, OIB," & Choose(cll.Column, 0, 3, 0, 0, 0, 0, 2, 0, 6, 0, 0, 4, 5) & ", 0),"""")"
' IsEmpty(cll) Then cll.FormulaR1C1 = "=IFERROR(VLOOKUP(RC5, OIB," & Choose(cll.Column, A, B, C, D, E, F, G, H, I, J, K, L, M) & ", 0),"""")"
Next cll
End If
'AUTO CAPS
Set RngToCheckForUserInput = Intersect(Target, Range("G4:G6,B9:M28,G31:G39"))
If Not RngToCheckForUserInput Is Nothing Then
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
For Each cll In RngToCheckForUserInput.Cells
If Not cll.HasFormula And Len(cll.Value) > 0 Then cll.Value = UCase(cll.Value)
Next cll
End If
GracefulExit:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub