macro/formula assistance!!

[mbertel]

Currently using exel 2007. The file format is xlsm. Currently running a macro that returns the previous value of cells in only two columns if the cell is either "0" or blank. When ever I drage the formula from one cell down to another cell I get the value of the cell I dragging from. How I am dragging is putting the mouse in bottom right of cell so pointer turns to plus sign, then I drag. If I right click(copy, paste special, click on formula) it works. I am copying the macro code so this makes this issue more clear. I hope. I need help on being able to drag the formula down and applying the formula not value. Thank you for any help. This is a tough problem for me.

Private oldValArr() As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer

i = 0
If Target.Column = 38 Or Target.Column = 48 Then
For Each rngCell In Target
If CStr(rngCell.Value) = "0" Or CStr(rngCell.Value) = "" Then
If oldValArr(i) <> "" Then
rngCell.Value = oldValArr(i)
End If
Exit For
End If
i = i + 1

' This If statement to avoid timing issue when users select the whole column
If i > 2000 Then
Exit For
End If
Next
ReDim oldValArr(0)
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo ErrorHandler

Dim i As Integer

i = 0
If Target.Column = 38 Or Target.Column = 48 Then
ReDim oldValArr(Target.Rows.Count)

If Target.MergeCells = False And Target.Columns.Count = 1 Then
For Each rngCell In Target
If CStr(rngCell.Value) = "Error 2042" Then
rngCell.Value = ""
End If
oldValArr(i) = CStr(rngCell.Value)
i = i + 1

' This If statement to avoid timing issue when users select the whole column
If i > 2000 Then
Exit For
End If
Next
End If
End If

Exit Sub

ErrorHandler:
MsgBox "Please contact Markus Bertel or Shane Tran when seeing exception errors."
End Sub

 

[hiker95]

mbertel,

When ever I drage the formula from one cell down to another cell

Can we see the formula?

 

[mbertel]

=VLOOKUP(A11,'C:\Users\bertem\Desktop\[1Q11TPOrpt.xls]1Q11_CSR'!$A$5:$E$500,4,FALSE)

It is a vlookup formula linked to another workbook. This is the formula that needs to be able to be dragged down(move the mouse pointer to bottom right of cell until arrow turns to a black plus, then hold the left mouse button down and drag to cells below) is what I am trying to do.

 

[hiker95]

mbertel,

I was not able to follow your original code, when I first replied to your post, becuase of the way it was posted.

If posting VBA code, please use Code Tags, see below in my Signature block: If posting VBA code, please use Code Tags - like this



The Worksheet_Change Event and the Worksheet_SelectionChange may be conflicting with each other because both monitor columns 38 and 48.


See the changes in bold, then:


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Select the worksheet in which your code is to run
3. Right click on the sheet tab and choose View Code, to open the Visual Basic Editor
4. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
5. Press the keys ALT + Q to exit the Editor, and return to Excel

Option Explicit
Private oldValArr() As String

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim i As Integer
i = 0
If Target.Column = 38 Or Target.Column = 48 Then
  For Each rngCell In Target
    If CStr(rngCell.Value) = "0" Or CStr(rngCell.Value) = "" Then
    If oldValArr(i) <> "" Then
      rngCell.Value = oldValArr(i)
      End If
      Exit For
    End If
    i = i + 1
    ' This If statement to avoid timing issue when users select the whole column
    If i > 2000 Then
      Exit For
    End If
  Next
  ReDim oldValArr(0)
End If
Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo ErrorHandler
Dim i As Integer
i = 0
If Target.Column = 38 Or Target.Column = 48 Then
  ReDim oldValArr(Target.Rows.Count)
  If Target.MergeCells = False And Target.Columns.Count = 1 Then
    For Each rngCell In Target
      If CStr(rngCell.Value) = "Error 2042" Then
        rngCell.Value = ""
      End If
      oldValArr(i) = CStr(rngCell.Value)
      i = i + 1
      ' This If statement to avoid timing issue when users select the whole column
      If i > 2000 Then
        Exit For
      End If
    Next
  End If
End If
Application.EnableEvents = True
Exit Sub
ErrorHandler:
MsgBox "Please contact Markus Bertel or Shane Tran when seeing exception errors."
Application.EnableEvents = True
End Sub