+ Reply to Thread
Results 1 to 4 of 4

It takes 1-2 minutes to respond when changing a value of cell

Hybrid View

  1. 08-19-2014, 02:30 AM #1
    jayce_sos
    jayce_sos is offline
    Registered User
    Join Date
    01-02-2013
    Location
    Philippines
    MS-Off Ver
    Excel 2003
    Posts
    22

    It takes 1-2 minutes to respond when changing a value of cell

    I have here a vba code for my excel. Primary function is to count number of days from a dates and return a number with conditional formatting of a cell. My problem is every time I change a value in a cell it take 2-3 minutes long to respond. I already tried the screenupdating function but with no luck same issue encountered. Below is the source code. Anyone knows how to fix this? Thank you in advance.

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

On Error Resume Next
If Target.Address <> "I:J" Then
If Target.Count = 9 Then Exit Sub
If Target.Column = 9 Then
  Select Case UCase(Target.Value)
    Case "WL"
      lngNumber = 5
    Case "BL"
      lngNumber = 7
    Case "CIL", "SL", "TYL"
      lngNumber = 15
    Case "RAM", "CPR"
      lngNumber = 30
    Case Else
      lngNumber = 0
  End Select
End If
End If

If lngNumber < 31 Then
  Application.EnableEvents = False
  Target.Offset(0, 1).Value = lngNumber
  Application.EnableEvents = True
End If

If Target.Count = 1 Then
  If Not Intersect(Target, Range("H:J")) Is Nothing Then
    Application.EnableEvents = False
      Cells(Target.Row, "K").Value = Format(Cells(Target.Row, "H") + Cells(Target.Row, "J"), "MMM DD, YYYY")
    Application.EnableEvents = True
  End If
End If

If Target.Address <> "L:L" Then
If Target.Count = 1 Then
    Application.EnableEvents = False
    Cells(Target.Row, "L").Value = (Cells(Target.Row, "K") - (Now()) + 1)
    Application.EnableEvents = True
End If
End If

If Target.Address <> "M:H" Then
If Target.Count = 1 Then
      Application.EnableEvents = False
      Cells(Target.Row, "N").Value = Cells(Target.Row, "M") - Cells(Target.Row, "H")
      ActiveSheet.UsedRange.Columns("N").NumberFormat = "General"
      Application.EnableEvents = True
      
End If
End If
End Sub
    Last edited by jayce_sos; 08-22-2014 at 02:35 AM.
    Reply With QuoteRegister To Reply
  2. 08-19-2014, 03:00 AM #2
    Fotis1991
    Fotis1991 is offline
    Forum Expert Fotis1991's Avatar
    Join Date
    10-11-2011
    Location
    Athens(The homeland of the Democracy!). Greece
    MS-Off Ver
    Excel 1997!&2003 & 2007&2010
    Posts
    13,744

    Re: It takes 1-2 minutes to respond when changing a value of cell

    Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

    Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

    Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



    (This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)
    Regards

    Fotis.

    -This is my Greek whisper to Europe.

    --Remember, saying thanks only takes a second or two. Click the little star * below, to give some Rep if you think an answer deserves it.

    Advanced Excel Techniques: http://excelxor.com/

    --KISS(Keep it simple Stupid)

    --Bring them back.

    ---See about Acropolis of Athens.

    --Visit Greece.
    Reply With QuoteRegister To Reply
  3. 08-19-2014, 03:06 AM #3
    jayce_sos
    jayce_sos is offline
    Registered User
    Join Date
    01-02-2013
    Location
    Philippines
    MS-Off Ver
    Excel 2003
    Posts
    22

    Re: It takes 1-2 minutes to respond when changing a value of cell

    Opps Sorry. It is clearer now? See below bracketed code.

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

On Error Resume Next
If Target.Address <> "I:J" Then
If Target.Count = 9 Then Exit Sub
If Target.Column = 9 Then
Select Case UCase(Target.Value)
Case "WL"
lngNumber = 5
Case "BL"
lngNumber = 7
Case "CIL", "SL", "TYL"
lngNumber = 15
Case "RAM", "CPR"
lngNumber = 30
Case Else
lngNumber = 0
End Select
End If
End If

If lngNumber < 31 Then
Application.EnableEvents = False
Target.Offset(0, 1).Value = lngNumber
Application.EnableEvents = True
End If

If Target.Count = 1 Then
If Not Intersect(Target, Range("H:J")) Is Nothing Then
Application.EnableEvents = False
Cells(Target.Row, "K").Value = Format(Cells(Target.Row, "H") + Cells(Target.Row, "J"), "MMM DD, YYYY")
Application.EnableEvents = True
End If
End If

If Target.Address <> "L:L" Then
If Target.Count = 1 Then
Application.EnableEvents = False
Cells(Target.Row, "L").Value = (Cells(Target.Row, "K") - (Now()) + 1)
Application.EnableEvents = True
End If
End If

If Target.Address <> "M:H" Then
If Target.Count = 1 Then
Application.EnableEvents = False
Cells(Target.Row, "N").Value = Cells(Target.Row, "M") - Cells(Target.Row, "H")
ActiveSheet.UsedRange.Columns("N").NumberFormat = "General"
Application.EnableEvents = True

End If
End If
End Sub
    Reply With QuoteRegister To Reply
  4. 08-19-2014, 03:07 AM #4
    jayce_sos
    jayce_sos is offline
    Registered User
    Join Date
    01-02-2013
    Location
    Philippines
    MS-Off Ver
    Excel 2003
    Posts
    22

    Re: It takes 1-2 minutes to respond when changing a value of cell

    Opps Sorry. It is clearer now? See below bracketed code.

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

On Error Resume Next
If Target.Address <> "I:J" Then
If Target.Count = 9 Then Exit Sub
If Target.Column = 9 Then
Select Case UCase(Target.Value)
Case "WL"
lngNumber = 5
Case "BL"
lngNumber = 7
Case "CIL", "SL", "TYL"
lngNumber = 15
Case "RAM", "CPR"
lngNumber = 30
Case Else
lngNumber = 0
End Select
End If
End If

If lngNumber < 31 Then
Application.EnableEvents = False
Target.Offset(0, 1).Value = lngNumber
Application.EnableEvents = True
End If

If Target.Count = 1 Then
If Not Intersect(Target, Range("H:J")) Is Nothing Then
Application.EnableEvents = False
Cells(Target.Row, "K").Value = Format(Cells(Target.Row, "H") + Cells(Target.Row, "J"), "MMM DD, YYYY")
Application.EnableEvents = True
End If
End If

If Target.Address <> "L:L" Then
If Target.Count = 1 Then
Application.EnableEvents = False
Cells(Target.Row, "L").Value = (Cells(Target.Row, "K") - (Now()) + 1)
Application.EnableEvents = True
End If
End If

If Target.Address <> "M:H" Then
If Target.Count = 1 Then
Application.EnableEvents = False
Cells(Target.Row, "N").Value = Cells(Target.Row, "M") - Cells(Target.Row, "H")
ActiveSheet.UsedRange.Columns("N").NumberFormat = "General"
Application.EnableEvents = True

End If
End If
End Sub
    Reply With QuoteRegister To Reply
+ Reply to Thread
« Previous Thread | Next Thread »

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. VBA Code takes 10 minutes of crunch time to return result.
    By jaimeteele in forum Excel Programming / VBA / Macros
    Replies: 9
    Last Post: 02-28-2013, 02:19 PM
  2. Excel takes 15 minutes to change an option
    By cloke in forum Excel General
    Replies: 4
    Last Post: 02-11-2013, 07:15 AM
  3. My current macro takes 20 minutes + to run. How can this code be made more efficient??!!
    By Mr.Whiskers in forum Excel Programming / VBA / Macros
    Replies: 8
    Last Post: 04-11-2012, 11:02 AM
  4. Slow for each check takes 6 minutes
    By wolfen in forum Excel General
    Replies: 2
    Last Post: 03-02-2012, 10:33 AM
  5. [SOLVED] File takes 40 minutes to load (auto-calculation)
    By R L in forum Excel General
    Replies: 1
    Last Post: 01-26-2005, 07:06 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Forum Rules


Search Engine Friendly URLs by vBSEO 3.6.0 RC 1