make code shorter as excel gets stuck

aayaanmayank

Board Regular
Joined
Jul 20, 2018
Messages
157
Hi Can anyone help me to make below code shorter as whenever my i run the code along with different set of code, it always gets hang when macro reach to this code.

Sub Groupingname()


Application.ScreenUpdating = False

Set shgroup = ThisWorkbook.Worksheets("Data")




Range("I2").Select
For U = 2 To lastrow1


Set MYNAME0 = Cells((U + 1), ("I"))
Set MYNAME1 = Cells(U, "j")
Set MYNAME2 = Cells(U, "I")


If MYNAME0.Interior.Color = vbYellow Or MYNAME0.Interior.Color = vbGreen And MYNAME0.Value = MYNAME1.Value Then

If IsEmpty(shgroup.Cells((U + 1), ("I"))) = False Then
MYNAME0.Interior.Color = vbGreen
MYNAME1.Interior.Color = vbGreen
MYNAME2.Interior.Color = vbGreen

Else:
End If
End If
Next U

end sub
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Re: make code sorter as excel gets stuck

Where is the code getting the value of lastrow1 ?
Is this why it is getting stuck?
 
Upvote 0
Re: make code sorter as excel gets stuck

No. Lastrow1 is providing the count of rows " lastrow1 = shgroup.Range("B" & Rows.Count).End(xlUp).Row "
 
Upvote 0
Re: make code sorter as excel gets stuck

1. What is the active sheet when the code is run?

2. On which sheet is the code supposed to be checking information in columns I & J?

3. Where is the code located?
- In a standard Module of the workbook being acted on?
- In a worksheet module? If so, which worksheet's module
- Somewhere else? Where?

4. Does your code give an error message? What is the evidence that you say the code "hangs"? What actually happens?
 
Upvote 0
Re: make code sorter as excel gets stuck

No. Lastrow1 is providing the count of rows " lastrow1 = shgroup.Range("B" & Rows.Count).End(xlUp).Row "

Where is that line in the code you posted in post number 1? Post your full code (in code tags ideally, paste your code, select it and click the # icon)

What sheet are MYNAME0, MYNAME1 and MYNAME2 on?

Edit: I see Peter got in before me :( Please make sure you see and answer his questions
 
Last edited:
Upvote 0
Re: make code sorter as excel gets stuck

You can group cells using the Union function and apply the formatting in a single hit like this

Code:
Sub Groupingname()
    Dim MYNAME0 As Range, MYNAME1 As Range, MYNAME2 As Range
    Dim lastrow1 As Long, U As Long, shgroup As Worksheet
    [COLOR=#000080]Dim rng As Range, rng1 As Range[/COLOR]
    Application.ScreenUpdating = False
    Set shgroup = ThisWorkbook.Worksheets("Data")
    lastrow1 = shgroup.Range("B" & Rows.Count).End(xlUp).Row
    Range("I2").Select
    For U = 2 To lastrow1
        Set MYNAME0 = Cells((U + 1), ("I"))
        Set MYNAME1 = Cells(U, "j")
        Set MYNAME2 = Cells(U, "I") 
        If MYNAME0.Interior.Color = vbYellow Or MYNAME0.Interior.Color = vbGreen And MYNAME0.Value = MYNAME1.Value Then
            If IsEmpty(shgroup.Cells((U + 1), ("I"))) = False Then
                [COLOR=#000080]Set rng = [/COLOR][COLOR=#ff0000]Union[/COLOR][COLOR=#000080](MYNAME0, MYNAME1, MYNAME2)[/COLOR]
                I[COLOR=#000080]f rng1 Is Nothing Then Set rng1 = rng Else Set rng1 = [/COLOR][COLOR=#ff0000]Union[/COLOR][COLOR=#000080](rng1, rng)[/COLOR]
            Else:

            End If
        End If
    Next U
        [COLOR=#000080]rng1.Interior.Color = vbGreen[/COLOR]
End Sub

This method will work for you unless you have too many ranges for Union to handle
I have merely tailored your code - but ranges should be qualified with a sheet reference - hence Peter's questions
 
Last edited:
Upvote 0
Re: make code sorter as excel gets stuck

What is the active sheet when the code is run? Activesheet name is "DATA" and in same sheet its referring to column I & J
Code is locate in Simple Module

My code does not hang, excel gets hang while running this code and i get error" Microsoft Excel is not responding" and excel restart
 
Upvote 0
Re: make code sorter as excel gets stuck

Hi everything is happening and all the variables are set in only for one sheet which is named as "Data"

i understand if it will refer to some different sheet or location. i will get Application/Object Defined Error. however my mean due to verify too many conditions my excel gets hang and restarts most of the time. i have data for 30K rows.
 
Last edited:
Upvote 0
Re: make code sorter as excel gets stuck

Sorry I cant paste entire code over here bec it extremely long i am just pasting part of my entire code and where after reaching my excel get hang most of the times.

Sub Groupingname()


Set shgroup = ThisWorkbook.Worksheets("Data")
lastrow1 = shgroup.Range("B" & Rows.Count).End(xlUp).Row


Range("I2").Select
For U = 2 To lastrow1


Set MYNAME0 = Cells((U + 1), ("I"))
Set MYNAME1 = Cells(U, "j")
Set MYNAME2 = Cells(U, "I")


If (MYNAME0.Interior.Color = vbYellow Or MYNAME0.Interior.Color = vbGreen) And MYNAME0.Value = MYNAME1.Value Then

If IsEmpty(shgroup.Cells((U + 1), ("I"))) = False Then
MYNAME0.Interior.Color = vbGreen
MYNAME1.Interior.Color = vbGreen
MYNAME2.Interior.Color = vbGreen

Else:
End If
End If
Next U


end sub
 
Upvote 0
Re: make code sorter as excel gets stuck

Sorry I cant paste entire code over here bec it extremely long i am just pasting part of my entire code

Did you try it? (you obviously didn't try the code tags).
Without the entire code I am afraid I am dropping out of the thread as I can't be certain what relevant code you haven't posted (especially as you already left out 1 important line in the original post).
 
Upvote 0

Forum statistics

Threads
1,223,910
Messages
6,175,320
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top