Excel file hangs when trying to change the drop down value which has VBA script

[BMD44]

Hello All,

I have an excel file which is populating target values (Col B) for the source value (Col J) selected from the drop down. These values are for different ERPs.

The ERP is given in cell K4 (Choice_SE) field.

I have code which when selecting ERP in cell K4 from drop down, it should clear the existing values. New values will then be entered for the ERP selected in K4.

But, when I do this, the excel hangs with out clearing the data.

I think this is because of the If Not intersect code. Please suggest how can we keep if Not Intersect code in a separate function.

Thanks in advance.

 

[MARK858]

Try changing the line

For Each cell In Intersect(Target, Range("J:J"))

to

For Each cell in Intersect(Target, Range("J1:J" & Range("J" & Rows.Count).End(xlUp).Row))

and see if it makes a difference

P.S. if posting code please post it directly in the thread (in code tags) and not as an image, so we can copy/paste it into Excel without retyping it

How to Post Your VBA Code

Post your VBA code.

www.mrexcel.com

 

[BMD44]

Thanks for the reply. sorry for not posting the code directly.

I made the change and I still see the issue. Can I have the code to generate company code, in the below section in a separate function.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Start_Row, Found_Row
Dim SubEnt_Col
Dim NumJrnl_Recs
Dim strInput As String
Dim MsgBoxClick
Dim cell As Range

Application.ScreenUpdating = False

If Target.Address = Range("Choice_SE").Address Then
MsgBoxClick = MsgBox("Changing the ERP will clear all the details you entered." _
& vbCrLf & vbCrLf & "Enter/Select New co.code (Col J) and Local Account (Col G) to start filling the template." _
& vbCrLf & vbCrLf & "Are you sure you want to continue?", vbYesNo, "Clear Journal Detail")

If MsgBoxClick = vbYes Then

Union(Range("C8:C2000"), Range("E8:E2000").Resize(, 7), Range("M8:M2000").Resize(, 3)).ClearContents

End If

End If

=============company code==============

If Not Intersect(Target, Range("J1:J" & Range("J" & Rows.Count).End(xlUp).Row)) Is Nothing Then
Application.EnableEvents = False
For Each cell In Intersect(Target, Range("J:J"))
cell.Offset(, -8) = IIf(cell <> "", Application.VLookup(cell & Range("K4"), Sheets("Coco").Range("A:D"), 4, 0), "")
Next cell
Application.EnableEvents = True
End If

Application.ScreenUpdating = True

End Sub

 

[MARK858]

That code doesn't include the code I posted since the edit 3 hours ago, have you tested with the edited code?

 

[BMD44]

That code doesn't include the code I posted since the edit 3 hours ago, have you tested with the edited code?

Thanks for the reply. sorry for not posting the code directly.

I made the change and I still see the issue. Can I have the code to generate company code, in the below section in a separate function.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Start_Row, Found_Row
Dim SubEnt_Col
Dim NumJrnl_Recs
Dim strInput As String
Dim MsgBoxClick
Dim cell As Range

Application.ScreenUpdating = False

If Target.Address = Range("Choice_SE").Address Then
MsgBoxClick = MsgBox("Changing the ERP will clear all the details you entered." _
& vbCrLf & vbCrLf & "Enter/Select New co.code (Col J) and Local Account (Col G) to start filling the template." _
& vbCrLf & vbCrLf & "Are you sure you want to continue?", vbYesNo, "Clear Journal Detail")

If MsgBoxClick = vbYes Then

Union(Range("C8:C2000"), Range("E8:E2000").Resize(, 7), Range("M8:M2000").Resize(, 3)).ClearContents

End If

End If

=============company code==============

If Not Intersect(Target, Range("J1:J" & Range("J" & Rows.Count).End(xlUp).Row)) Is Nothing Then
Application.EnableEvents = False
For Each cell In Intersect(Target, Range("J:J"))
cell.Offset(, -8) = IIf(cell <> "", Application.VLookup(cell & Range("K4"), Sheets("Coco").Range("A:D"), 4, 0), "")
Next cell
Application.EnableEvents = True
End If

Application.ScreenUpdating = True

End Sub

 

[BMD44]

Hi, Below is the code I updated. It still does not work. Is there a way I can attach the excel file here. I do not see the option.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Start_Row, Found_Row
Dim SubEnt_Col
Dim NumJrnl_Recs
Dim strInput As String
Dim MsgBoxClick
Dim cell As Range

Application.ScreenUpdating = False

If Target.Address = Range("Choice_SE").Address Then
MsgBoxClick = MsgBox("Changing the ERP will clear all the details you entered." _
& vbCrLf & vbCrLf & "Enter/Select New co.code (Col J) and Local Account (Col G) to start filling the template." _
& vbCrLf & vbCrLf & "Are you sure you want to continue?", vbYesNo, "Clear Journal Detail")

If MsgBoxClick = vbYes Then

Union(Range("C8:C2000"), Range("E8:E2000").Resize(, 7), Range("M8:M2000").Resize(, 3)).ClearContents

End If

End If

============= Company Code==============

If Not Intersect(Target, Range("J:J")) Is Nothing Then
    Application.EnableEvents = False
    For Each cell In Intersect(Target, Range("J1:J" & Range("J" & Rows.Count).End(xlUp).Row))
    cell.Offset(, -8) = IIf(cell <> "", Application.VLookup(cell & Range("K4").Value, Sheets("Coco").Range("A:D"), 4, 0), "")
  Next cell
  Application.EnableEvents = True
End If
 Application.ScreenUpdating = False
       
End Sub

 

[MARK858]

The nearest you will get to attaching a file is to upload your file to a free file hosting site like www.box.com or www.dropbox.com, mark the file for sharing and post the link it provides in the thread.

Can you tell me what exactly you are trying to do in words with the For each line as I don't know exactly what you are using the Intersect for in that line

 

[BMD44]

Hi Mark,

I have uploaded 2 sheets of my excel template.

In sheet1, we have cell K4 which is ERP and this is drop down. Once we select value from the drop down, it should display message to clear all the details. Once the details are cleared, then we should select values based on the ERP selected which is col J. Col J is again a drop-down which gives source CoCo values for the ERP selected. These source and Target values are in sheet 2.

In my code, I have the logic to clear the values upon ERP selection and to populate target values based on source are in the same block

Private Sub Worksheet_Change(ByVal Target As Range)

Not sure, if this is causing issue in clearing the values when selecting ERPs. Also, while populate target value which is the second section of the code, I am referring to cell K4.

This is just for Coco. I need to replicate the same for other fields like Acct as well. If I include the logic for all the columns in Worksheet_Change and try to select ERP, then the file just hangs.


Please suggest. Let me know if any other details are required.

 

[MARK858]

First of all images are of no use to me in this circumstance (I wouldn't want to retype the data into Excel anyway, which is why we recommend using the boards XL2BB addin or if necessary uploading a file to a file hosting site)

Col J is again a drop-down

If column J is a dropdown then Target is only a single cell as you are changing only one cell at a time, yes?

 

[BMD44]

First of all images are of no use to me in this circumstance (I wouldn't want to retype the data into Excel anyway, which is why we recommend using the boards XL2BB addin or if necessary uploading a file to a file hosting site)


If column J is a dropdown then Target is only a single cell as you are changing only one cell at a time, yes?

Hi Mark,

I am trying to upload file.

Meanwhile, to your question, yes. Col J is a drop down for source and target is only a single which is based on the value in column J