My code was working 2 days back but now my excel just crashes. Thank for any help in Advance!

[MrArchitAgarwal]

I am using 2 Worksheet_Change Events and the code was working great 2 days back but from yesterday the code stopped working and excel started crashing. Please Help.

This is the code I am using for the Worksheet

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim xRInt As Integer
Dim xDStr As String
Dim xFStr As String
Dim xSStr As String
On Error Resume Next
xDStr = "G" 'Data Column
xFStr = "Y" 'Created Column
xSStr = "Z" 'Updated Column
If (Not Application.Intersect(Me.Range("G2:G"), Target) Is Nothing) Then
xRInt = Target.Row
If Me.Range(xFStr & xRInt) = "" Then
Me.Range(xFStr & xRInt) = Format(Now(), "mm/dd/yyyy hh:mm:ss")
End If
Me.Range(xSStr & xRInt) = Format(Now(), "mm/dd/yyyy hh:mm:ss")
End If



'_____________________________________________________________________________________________________________________________



Dim rng As Range
Dim cell As Range
Dim sizes() As String
Dim startSize As String
Dim endSize As String
Dim i As Integer
On Error Resume Next
' Define the range where the sizes should be generated
Set rng = Intersect(Target, Me.Range("J2:J"))

If Not rng Is Nothing Then
Application.EnableEvents = False

For Each cell In rng
If InStr(1, UCase(cell.Value), "-") > 0 Then
' Split the input into start and end sizes
sizes = Split(UCase(cell.Value), "-")
startSize = sizes(0)
endSize = sizes(1)

' Clear the original cell
cell.ClearContents

' Calculate and fill the cells downward with sizes
For i = 0 To 100 ' Increase this number to cover a larger range
cell.Offset(i, 0).Value = startSize
If UCase(startSize) = UCase(endSize) Then Exit For
startSize = GetNextSize(UCase(startSize))
Next i
End If
Next cell

Application.EnableEvents = True
End If
End Sub

Function GetNextSize(currentSize As String) As String
Select Case currentSize
Case "S"
GetNextSize = "M"
Case "M"
GetNextSize = "L"
Case "L"
GetNextSize = "XL"
Case "XL"
GetNextSize = "2XL"
Case "2XL"
GetNextSize = "3XL"
Case Else
GetNextSize = currentSize
End Select
End Function

SR.NO.	BARCODE	PARTY NAME	PARTY CODE	ITEM CODE	STYLE	COLOUR	SIZE	QUANTITY	PURCHASE PRICE	PURCHASE VALUE	% DISC FORWARD	DISCOUNT IN RS.	LANDING COST	WHOLESALE	RETAIL	MRP	WHOLESALE NAME	NAME ARONIUM	PRICE ARONIUM	STATUS - ARONIUM	STATUS - BARCODE	Date Created	Date Modified	Month created	Year Created
1	880401	J. K. TEXTILES	JK	2781	CO-ORD SET	PINK	L	3	1795	5385	0	0	1795	224	280	4500	CO-ORD SET 2781K224J	CO-ORD SET 2781K224J - L PINK	2700	UPDATED	PRINTED
2	880402	J. K. TEXTILES	JK	2781	CO-ORD SET	PINK	XL	3	1795	5385	0	0	1795	224	280	4500	CO-ORD SET 2781K224J	CO-ORD SET 2781K224J - XL PINK	2700	UPDATED	PRINTED
3	880403	J. K. TEXTILES	JK	2782	CROP TOP - DRAPE	PINK	L	3	1795	5385	0	0	1795	224	280	4500	CROP TOP - DRAPE 2782K224J	CROP TOP - DRAPE 2782K224J - L PINK	2700	UPDATED	PRINTED
4	880404	J. K. TEXTILES	JK	2782	CROP TOP - DRAPE	PINK	XL	3	1795	5385	0	0	1795	224	280	4500	CROP TOP - DRAPE 2782K224J	CROP TOP - DRAPE 2782K224J - XL PINK	2700	UPDATED	PRINTED
5	880405	J. K. TEXTILES	JK	2783	GOWN	PINK	M	3	1695	5085	0	0	1695	212	270	4300	GOWN 2783K212J	GOWN 2783K212J - M PINK	2600	UPDATED	PRINTED

 

[Alex Blakenburg]

In the first macro add turn off and back on the EnableEvents in the positions shown below:
(You already have this covered in the 2nd macro)

    If (Not Application.Intersect(Me.Range("G2:G"), Target) Is Nothing) Then
        Application.EnableEvents = False
        xRInt = Target.Row
        If Me.Range(xFStr & xRInt) = "" Then
            Me.Range(xFStr & xRInt) = Format(Now(), "mm/dd/yyyy hh:mm:ss")
        End If
        Me.Range(xSStr & xRInt) = Format(Now(), "mm/dd/yyyy hh:mm:ss")
        Application.EnableEvents = True
    End If

 

[MrArchitAgarwal]

Thanks, I tried that and it did work.

Now, any changes in any row is causing the first code to activate while the second code doesn't work at all. Can you please guide me on that to....

(P.S. I am a beginner in Excel)

 

[Alex Blakenburg]

Firstly change the 2 intersect line to the code below:
(Your current code runs from G2:G and J2:J which doesn't work - it either needs the row number for the end cell or drop the row no and reference the whole column as in the code below)

Secondly your second macro looks for a dash "-" in column J but column J in your example is a number so it is never going to find a dash.
Should it be column S ?

   ' Macro 1
    If Not Application.Intersect(Me.Range("G:G"), Target) Is Nothing Then
    ' Macro 2
    Set rng = Intersect(Target, Me.Range("J:J"))

 

[MrArchitAgarwal]

Firstly change the 2 intersect line to the code below:
(Your current code runs from G2:G and J2:J which doesn't work - it either needs the row number for the end cell or drop the row no and reference the whole column as in the code below)

Secondly your second macro looks for a dash "-" in column J but column J in your example is a number so it is never going to find a dash.
Should it be column S ?

   ' Macro 1
    If Not Application.Intersect(Me.Range("G:G"), Target) Is Nothing Then
    ' Macro 2
    Set rng = Intersect(Target, Me.Range("J:J"))

No, The Row J is which contains Size, Due to Some hidden columns it isn't appearing correctly. Also Row G is Item Code. I have written the code in such a way that If i write S-XL in a cell in Column J, Then The cell will be filled with S, The lower cell will be filled with M, The further lower cell with L, then XL. But the code doesn't enter the loop. Please provide a solution, i couldn't -find one even after brainstorming for so much time

Also, the first code worked after I replaced
If (Not Application.Intersect(Me.Range("G2:G"), Target) Is Nothing) Then
with
If Not Intersect(Target, Me.Range("G2:G" & Me.Rows.Count)) Is Nothing Then

 

[Alex Blakenburg]

Also, the first code worked after I replaced
If (Not Application.Intersect(Me.Range("G2:G"), Target) Is Nothing) Then
with
If Not Intersect(Target, Me.Range("G2:G" & Me.Rows.Count)) Is Nothing Then

We are going to get very far if you don't implement the suggestions provided.

 

[MrArchitAgarwal]

But if I change the header of Item Code, it will also change the header of Date Updated to the Date of Change...

 

[Alex Blakenburg]

OK then try these 2:

    If Not Intersect(Target, Me.Range("G2:G" & Me.Cells(Rows.Count, "G").End(xlUp).Row)) Is Nothing Then

    Set rng = Intersect(Target, Me.Range("J2:J" & Me.Cells(Rows.Count, "J").End(xlUp).Row))

 

[MrArchitAgarwal]

Yes, The code now works perfectly. Thanks a lot Alex.

 

[Alex Blakenburg]

No problem. Glad I could help.