2

I have code that retrieves information from SQL and VFP and populates a dropdown list in every cell in column "A" except A1 - this is a header.

I need to populate the "G" column on the row where the user selects the value from a dropdown in the "A" column.

I believe I need to be in Private Sub Worksheet_SelectionChange(ByVal Target As Range) which is in the sheet object.

Below is something similar to what I want to do.

If cell "a2".valuechanged then
    Set "g2" = "8000"
End if
If cell "a3".valueChanged then
    Set "g3" = "8000"
End if

The code above doesn't work, but I think it is easy to understand. I want to make this dynamic, so I don't have too many lines of code.

Community
  • 1
  • 1
John Janssen
  • 293
  • 2
  • 12
  • 30
  • No you need `Worksheet_Change` event. See [THIS](http://stackoverflow.com/questions/13860894/ms-excel-crashes-when-vba-code-runs/13861640#13861640) – Siddharth Rout Nov 05 '13 at 17:34

4 Answers4

4

I have already explained about events and other things that you need to take care when working with Worksheet_Change HERE

You need to use Intersect with Worksheet_Change to check which cell the user made changes to.

Is this what you are trying?

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    '~~> Check if user has selected more than one cell
    If Target.Cells.CountLarge > 1 Then Exit Sub

    Application.EnableEvents = False

    '~~> Check if the user made any changes in Col A
    If Not Intersect(Target, Columns(1)) Is Nothing Then
        '~~> Ensure it is not in row 1
        If Target.Row > 1 Then
            '~~> Write to relevant cell in Col G
            Range("G" & Target.Row).Value = 8000
        End If
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub
Community
  • 1
  • 1
Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
  • This code also worked like a charm. Your explanation on the other post was great. The first answer above, doesn't handle errors. I do like how you cover all basis. Thank you for your help. – John Janssen Nov 05 '13 at 18:34
1

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Row > 1 And Target.Column <> 7 Then
    Cells(Target.Row, "G").Value = 8000
  End If
End Sub

If you only need it to fire on column A then

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Row > 1 And Target.Column = 1 Then
    Cells(Target.Row, "G").Value = 8000
  End If
End Sub
engineersmnky
  • 25,495
  • 2
  • 36
  • 52
0

can you not put an if statement in column G , as in

If (A1<>"", 8000,0)

Other wise something like this will get you going:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 1 Then
If Target.Value2 <> "" Then
Target.Offset(0, 6) = "8000"
Else
Target.Offset(0, 6) = ""
End If
End If
On Error GoTo 0
End Sub

Thanks Ross

Ross
  • 300
  • 1
  • 8
0

I had a similar problem. I used Siddharth Rout's code. My modifications allow a user to paste a range of cells in column a (ex. A3:A6) and have multiple cells modified (ex. H3:H6).

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa

'~~> Check if user has selected more than one cell
If Target.Cells.CountLarge < 1 Then Exit Sub
If Target.Cells.CountLarge > 500 Then Exit Sub


Debug.Print CStr(Target.Cells.CountLarge)

Application.EnableEvents = False

Dim the_row As Range
Dim the_range As Range

Set the_range = Target

'~~> Check if the user made any changes in Col A
If Not Intersect(the_range, Columns(1)) Is Nothing Then
    For Each the_row In the_range.Rows
        '~~> Ensure it is not in row 2
        If the_row.Row > 2 Then
            '~~> Write to relevant cell in Col H
            Range("H" & the_row.Row).Value = Now
        End If
    Next
End If

Letscontinue: Application.EnableEvents = True Exit Sub Whoa: MsgBox Err.Description Resume Letscontinue End Sub

David Smolinski
  • 514
  • 3
  • 13