Excel-Not Responding State

G

GirishDhruva

Active Member
Joined
Mar 26, 2019
Messages
308
Hi everyone,
Here i am trying with this code for copying the values which are present in column 'B' based on column 'H' ,i have tried with the below code but it takes me lot of time , if i have huge data in my sheet, it goes to Excel-Not Responding State
Is their any other possible way to perform this

Here My main goal is to copy the values of column B that are present in between the values of column 'H' and paste that in another sheet
[TABLE="width: 500"]
<tbody>[TR]
[TD]Slno[/TD]
[TD]Column B[/TD]
[TD]...[/TD]
[TD]Column H[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]111[/TD]
[TD][/TD]
[TD]1212[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]222[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]333[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]444[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]555[/TD]
[TD][/TD]
[TD]12345[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]666[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]777[/TD]
[TD][/TD]
[TD]12333[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]888[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]999[/TD]
[TD][/TD]
[TD]12312[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]1000[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Code: 
Sub looping()
Dim lastrow, i As Long
lastrow = Cells(Rows.Count, "H").End(xlUp).Row
    For i = 2 To lastrow
        If Cells(i, 8).Value = "" Then
            Cells(i, 2).Copy
            Worksheets("Sheet2").Select
            Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
            Worksheets("Sheet2").Paste
            Worksheets("Sheet1").Select
        End If
    Next i
End Sub

Thanks in advance
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
All of the selecting and copying and pasting is not good practice. The code below loads everything into an array and uses that for the logic. A lot faster, and should take care of the 'not responding' garbage.

Code: 
Sub looping2()
Application.ScreenUpdating = False
Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
Dim AR() As Variant: AR = ws1.Range("A1:H" & Range("A" & Rows.Count).End(xlUp).Row).Value
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")


For i = LBound(AR) To UBound(AR)
    If AR(i, 8) = "" Then AL.Add AR(i, 2)
Next i


With ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(AL.Count)
    .Value = Application.Transpose(AL.toArray)
End With


Application.ScreenUpdating = True
End Sub
 
Upvote 0
lrobbo314 said:
All of the selecting and copying and pasting is not good practice. The code below loads everything into an array and uses that for the logic. A lot faster, and should take care of the 'not responding' garbage.

Code: 
Sub looping2()
Application.ScreenUpdating = False
Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
Dim AR() As Variant: AR = ws1.Range("A1:H" & Range("A" & Rows.Count).End(xlUp).Row).Value
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")


For i = LBound(AR) To UBound(AR)
    If AR(i, 8) = "" Then AL.Add AR(i, 2)
Next i


[COLOR=#ff0000]With ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(AL.Count)[/COLOR]
    .Value = Application.Transpose(AL.toArray)
End With


Application.ScreenUpdating = True
End Sub
Click to expand...
Thanks for your effort, but i am getting an error in highlighted row as "Application defined or object defined error"
could you help me what changes i have to make

Thank you in advance
 
Upvote 0
Made a couple of small changes.

Code: 
Sub looping2()
Application.ScreenUpdating = False
Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
Dim AR() As Variant: AR = ws1.Range("A2:H" & ws1.Range("A" & Rows.Count).End(xlUp).Row).Value
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")


For i = LBound(AR) To UBound(AR)
    If AR(i, 8) = "" Then AL.Add AR(i, 2)
Next i


With ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(AL.Count)
    .Value = Application.Transpose(AL.toArray)
End With


Application.ScreenUpdating = True
End Sub
 
Upvote 0
That's working , Thank you and one more doubt, if i need to copy multiple cells and paste in different columns in Sheet2

Like Below Table , i need to copy Column'B' values from Sheet1 and paste in Column'A' in Sheet2 and copy Column'M' from Sheet1 and paste to Column'Z' in Sheet2

[TABLE="width: 500"]
<tbody>[TR]
[TD]slno[/TD]
[TD]name[/TD]
[TD]column B[/TD]
[TD]Column H [/TD]
[TD]Column M[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]asedf[/TD]
[TD]111[/TD]
[TD]12345[/TD]
[TD]0987[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]qwer[/TD]
[TD]222[/TD]
[TD][/TD]
[TD]9876543[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]bsfdbfd[/TD]
[TD]333[/TD]
[TD][/TD]
[TD]8765[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]qwerf[/TD]
[TD]444[/TD]
[TD]5433[/TD]
[TD]34567[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]sadfdsf[/TD]
[TD]555[/TD]
[TD][/TD]
[TD]8765423[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]gedfgg[/TD]
[TD]666[/TD]
[TD]2345[/TD]
[TD]9876345[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]zvxcbvcjtr[/TD]
[TD]777[/TD]
[TD][/TD]
[TD]763267[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]eryewa[/TD]
[TD]888[/TD]
[TD]1345[/TD]
[TD]234586[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]rtesd[/TD]
[TD]999[/TD]
[TD][/TD]
[TD]23458754[/TD]
[/TR]
</tbody>[/TABLE]

Thanks in advance
 
Last edited:
Upvote 0
───────────────────░█▓▓▓█░▇▆▅▄▃▂
──────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
─────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
──────────░░░───░█▓▓▓▓▓▓█░▇▆▅▄▃▂ ...
─────────░███░──░█▓▓▓▓▓█░▇▆▅▄▃▂
───────░██░░░██░█▓▓▓▓▓█░▇▆▅▄▃▂
──────░█░░█░░░░██▓▓▓▓▓█░▇▆▅▄▃▂
────░██░░█░░░░░░█▓▓▓▓█░▇▆▅▄▃▂
───░█░░░█░░░░░░░██▓▓▓█░▇▆▅▄▃▂
──░█░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░█░░░█░░░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░█░░░░██░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░░█░░░░░██░░░█▓▓▓█░▇▆▅▄▃▂
─░█░█░░░█░░░░░░███▓▓▓▓█░▇▆▅▄▃▂
░█░░░█░░░██░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░█░░░░█████▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░░█░░░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░█░░░░██░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
─░█░█░░░░░████▓▓▓▓██░▇▆▅▄▃▂
─░█░░█░░░░░░░█▓▓██▓█░▇▆▅▄▃▂
──░█░░██░░░██▓▓█▓▓▓█░▇▆▅▄▃▂
───░██░░███▓▓██▓█▓▓█░▇▆▅▄▃▂
────░██▓▓▓███▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓▓▓▓▓▓█░▇▆▅▄▃▂───────────────────░█▓▓▓█░▇▆▅▄▃▂
──────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
─────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
──────────░░░───░█▓▓▓▓▓▓█░▇▆▅▄▃▂ ...
─────────░███░──░█▓▓▓▓▓█░▇▆▅▄▃▂
───────░██░░░██░█▓▓▓▓▓█░▇▆▅▄▃▂
──────░█░░█░░░░██▓▓▓▓▓█░▇▆▅▄▃▂
────░██░░█░░░░░░█▓▓▓▓█░▇▆▅▄▃▂
───░█░░░█░░░░░░░██▓▓▓█░▇▆▅▄▃▂
──░█░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░█░░░█░░░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░█░░░░██░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░░█░░░░░██░░░█▓▓▓█░▇▆▅▄▃▂
─░█░█░░░█░░░░░░███▓▓▓▓█░▇▆▅▄▃▂
░█░░░█░░░██░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░█░░░░█████▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░░█░░░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░█░░░░██░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
─░█░█░░░░░████▓▓▓▓██░▇▆▅▄▃▂
─░█░░█░░░░░░░█▓▓██▓█░▇▆▅▄▃▂
──░█░░██░░░██▓▓█▓▓▓█░▇▆▅▄▃▂
───░██░░███▓▓██▓█▓▓█░▇▆▅▄▃▂
────░██▓▓▓███▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓▓▓▓▓▓█░▇▆▅▄▃▂
 
Upvote 0
GirishDhruva said:
That's working , Thank you and one more doubt, if i need to copy multiple cells and paste in different columns in Sheet2

Like Below Table , i need to copy Column'B' values from Sheet1 and paste in Column'A' in Sheet2 and copy Column'M' from Sheet1 and paste to Column'Z' in Sheet2

[TABLE="width: 500"]
<tbody>[TR]
[TD]slno[/TD]
[TD]name[/TD]
[TD]column B[/TD]
[TD]Column H[/TD]
[TD]Column M[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]asedf[/TD]
[TD]111[/TD]
[TD]12345[/TD]
[TD]0987[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]qwer[/TD]
[TD]222[/TD]
[TD][/TD]
[TD]9876543[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]bsfdbfd[/TD]
[TD]333[/TD]
[TD][/TD]
[TD]8765[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]qwerf[/TD]
[TD]444[/TD]
[TD]5433[/TD]
[TD]34567[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]sadfdsf[/TD]
[TD]555[/TD]
[TD][/TD]
[TD]8765423[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]gedfgg[/TD]
[TD]666[/TD]
[TD]2345[/TD]
[TD]9876345[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]zvxcbvcjtr[/TD]
[TD]777[/TD]
[TD][/TD]
[TD]763267[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]eryewa[/TD]
[TD]888[/TD]
[TD]1345[/TD]
[TD]234586[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]rtesd[/TD]
[TD]999[/TD]
[TD][/TD]
[TD]23458754[/TD]
[/TR]
</tbody>[/TABLE]

Thanks in advance
Click to expand...

Can this be done????
 
Upvote 0
How about this?

Code: 
Sub looping2()
Application.ScreenUpdating = False
Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
Dim AR() As Variant: AR = ws1.Range("A2:M" & ws1.Range("A" & Rows.Count).End(xlUp).Row).Value
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim AL2 As Object: Set AL2 = CreateObject("System.Collections.ArrayList")




For i = LBound(AR) To UBound(AR)
    If AR(i, 8) = "" Then
        AL.Add AR(i, 2)
        AL2.Add AR(i, 13)
    End If
Next i




ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(AL.Count).Value = Application.Transpose(AL.toArray)
ws2.Range("Z" & Rows.Count).End(xlUp).Offset(1).Resize(AL2.Count).Value = Application.Transpose(AL2.toArray)


Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

ExcelNewbie2020
  • Solved
VBA to replicate values to allign with the longest non empty cell in other columns
Replies
1
Views
200
Eric W
Eric W
M
  • Question Question
Split Excel Workbook to separate .xlsx files for each unique value in Column A, also copy worksheet for Drop Down reference
Replies
9
Views
454
Alex Blakenburg
A
S
  • Question Question
Multiple columns lookup
Replies
0
Views
262
Sipirili2504
S
I
  • Question Question
Filter column on text value if that value exists using VBA
Replies
7
Views
277
Peter_SSs
Peter_SSs
M
  • Question Question
Re-produce code to copy last row from listbox on userform to sheet
Replies
3
Views
143
MKLAQ
M

Forum statistics

Threads
1,223,907
Messages
6,175,300
Members
452,633
Latest member
DougMo

Share this page

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