VBA Code Looping Question?

mayoung

Board Regular
Joined
Mar 26, 2014
Messages
181
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

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

Alex Blakenburg

Well-known Member
Joined
Feb 23, 2021
Messages
1,737
Office Version
  1. 365
Platform
  1. Windows
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 ?
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,066
Office Version
  1. 365
Platform
  1. Windows
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.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
62,537
Office Version
  1. 365
Platform
  1. Windows
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
 
Solution

Alex Blakenburg

Well-known Member
Joined
Feb 23, 2021
Messages
1,737
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

I was thinking
VBA Code:
 Cl.Offset(, 6).Value = Cl.Offset(1, 6).Value
But without more information the copy is safer.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
62,537
Office Version
  1. 365
Platform
  1. Windows
The OP's code is doing a copy, which is why I did the same thing.
 

mayoung

Board Regular
Joined
Mar 26, 2014
Messages
181
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
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>>>
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
62,537
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback.
 

Forum statistics

Threads
1,141,605
Messages
5,707,355
Members
421,503
Latest member
Rickys03

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
Top