VBA Code Looping Question?

mayoung

Active Member
Joined
Mar 26, 2014
Messages
257
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
Is there away to adjust this code so it does not have to loop twice or having no loop at all? This code works as is but just trying to make it faster.


VBA Code:
     Range("C:C").Select
     Selection.NumberFormat = "0"
    
        Range("C2").Select
        
   ' Stop
    
     Do While Not IsEmpty(ActiveCell.Offset(0, 0))
    
       If ActiveCell.Value = ActiveCell.Offset(1, 0).Value And ActiveCell.Offset(0, 4).Value = "SHOP IN RNTL" Then
       ActiveCell.Offset(1, 6).Select
       Selection.Copy
       ActiveCell.Offset(-1, 0).Select
       ActiveSheet.Paste
       Application.CutCopyMode = False
       ActiveCell.Offset(1, -6).Select
            
       Else
       ActiveCell.Offset(1, 0).Select

 End If
 
 Loop
 
         Range("C2").Select
    
     Do While Not IsEmpty(ActiveCell.Offset(0, 0))
    
       If ActiveCell.Value = ActiveCell.Offset(1, 0).Value And ActiveCell.Offset(0, 4).Value = "SHOP IN SALES" Then
       ActiveCell.Offset(1, 6).Select
       Selection.Copy
       ActiveCell.Offset(-1, 0).Select
       ActiveSheet.Paste
       Application.CutCopyMode = False
       ActiveCell.Offset(1, -6).Select
            
       Else
       ActiveCell.Offset(1, 0).Select

 End If
 
 Loop
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
A couple of questions:
1) Does your copy source contain a formula ?
2) Your 2 loops look to be identical except one selects SHOP IN RNTL & one SHOP IN SALES, is that correct ?
 
Upvote 0
Personally, I do not like trying to figure out ("guess") what code is supposed to do when there is no sample data and no explanation.
Make it easy for the people trying to help you by showing an example and explaining what you want to happen.

One thing you can do to speed it up is to get rid of all the Select statements. You do not need to select ranges to work with them, and doing so in a loop will really slow things down. See: How to Avoid the Select Method in VBA & Why - Excel Campus

You can also speed things up by disabling screen updating at the beginning of your code, and then turning it back on at the end.
See: Turn off Screen Updating - VBA Code Examples

Of course, eliminating/reducing loops will speed things up too, but I would need a better understanding of what you are trying to do before making any suggestions on that.
 
Upvote 0
How about
VBA Code:
Sub mayoung()
   Dim Cl As Range
   
   For Each Cl In Range("C2", Range("C" & Rows.Count).End(xlUp))
      If Cl.Value = Cl.Offset(1).Value And (Cl.Offset(, 4).Value = "SHOP IN RNTL" Or Cl.Offset(, 4).Value = "SHOP IN SALES") Then
         Cl.Offset(1, 6).Copy Cl.Offset(, 6)
      End If
   Next Cl
End Sub
 
Upvote 0
Solution
I was thinking
VBA Code:
 Cl.Offset(, 6).Value = Cl.Offset(1, 6).Value
But without more information the copy is safer.
 
Upvote 0
The OP's code is doing a copy, which is why I did the same thing.
 
Upvote 0
How about
VBA Code:
Sub mayoung()
   Dim Cl As Range
  
   For Each Cl In Range("C2", Range("C" & Rows.Count).End(xlUp))
      If Cl.Value = Cl.Offset(1).Value And (Cl.Offset(, 4).Value = "SHOP IN RNTL" Or Cl.Offset(, 4).Value = "SHOP IN SALES") Then
         Cl.Offset(1, 6).Copy Cl.Offset(, 6)
      End If
   Next Cl
End Sub
Works Well Thank You>>>
 
Upvote 0
Glad we could help & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,549
Messages
6,114,264
Members
448,558
Latest member
aivin

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