Looping of a macro

J

JODomingos

New Member
Joined
Jul 11, 2020
Messages
48
Office Version
  1. 2016
Platform
  1. Windows
Hello Friends!

I have a macro to perform a looping of a second macro in the module. Is there a way to rewritten that code differently? The main goal is repeat the macro many times. The number of times has to be variable.

Follows the macro I have.

Sub Repeat()

For x = 1 To 5828
Application.Run "Macro3!Codify"
Next x


End Sub
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Sort by date Sort by votes
What exactly does the Macro do?
Why does it have to be looped 5828 times?
It might help to see the code of the other macro.
 
Upvote 0
Hi Joe.
The macro has to replace multiple cells in one column based on a condition. What I need is a looping of this macro for x columns. For instance, the macro begins at yellow cell column, after that is moves to Column D, E. F, G .....
5828 is the number of the columns. But I can not mantain this value fixed, because sometimes I have more ou less column than that, so I need to input the value for every run.

thank you so much for your response

1600447986511.png






Sub Macro3()
'
'
'
Dim Rng As Range
Dim WorkRng As Range
Dim wb1 As Workbook
Set wb1 = ActiveWorkbook

Dim Replacement(2) As String
Dim x As Integer

Dim RAN As Range
Dim Z As Integer
Set RAN = ActiveCell

Application.ScreenUpdating = False


If RAN.Value = "A/G" Then

Range(Selection, Selection.End(xlDown)).Select

Selection.Offset(1, 0).Replace What:="AA", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Selection.Offset(1, 0).Replace What:="GG", Replacement:="-1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False


Else

If RAN.Value = "G/T" Then
Range(ActiveCell, ActiveCell.End(xlDown)).Select

Selection.Offset(1, 0).Replace What:="GG", Replacement:="-1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Selection.Offset(1, 0).Replace What:="TT", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Else

If RAN.Value = "G/C" Then
Range(ActiveCell, ActiveCell.End(xlDown)).Select

Selection.Offset(1, 0).Replace What:="GG", Replacement:="-1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Selection.Offset(1, 0).Replace What:="CC", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Else

If RAN.Value = "C/T" Then
Range(ActiveCell, ActiveCell.End(xlDown)).Select

Selection.Offset(1, 0).Replace What:="CC", Replacement:="-1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Selection.Offset(1, 0).Replace What:="TT", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False



Else

If RAN.Value = "A/C" Then
Range(ActiveCell, ActiveCell.End(xlDown)).Select

Selection.Offset(1, 0).Replace What:="AA", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Selection.Offset(1, 0).Replace What:="CC", Replacement:="-1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False



Else

If RAN.Value = "A/T" Then
Range(ActiveCell, ActiveCell.End(xlDown)).Select

Selection.Offset(1, 0).Replace What:="AA", Replacement:="-1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Selection.Offset(1, 0).Replace What:="TT", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False




End If
End If

End If
End If
End If
End If
ActiveCell.Offset(0, 1).Select

Application.ScreenUpdating = True


End Sub
 
Upvote 0
All those "Select" and "Selection" statements are really going to bog your code down. They shouldn't be necessary. You also don't need a separate macro to do the looping you can do it right in your Macro3 code.

I would dynamically find the last column with code, like this (assuming that we can use row 4 to find the last column).
You can then also find the last row in each dynamic column.
VBA Code: 
Dim lcol a Long
Dim c as long
Dim lrow as Long
Dim rng as Range

'Find last column in row 4
lcol = Cells(4,Columns.Count).End(xlToLeft).Column

'Loop through all columns
For c = 1 to lcol
'   Find last row in column
    lrow = Cells(Rows.Count,c).End(xlUp).Row
'   Set total range in column to search
    Set rng = Range(Cells(5,c),Cells(lrow,c))
'   Rest of your code to do your replacemetns below
    ...
Next c
So, you can see we were able to do all of that in one macro, and not need to have to use Select or Selection.
You should be able to do the rest without those too.
 
Upvote 0
I Understood your point. I am not so good about creating VBA script. How can I do it for this case? I tried to insert my code with your suggestion, but it did not work.
Although Macro3 takes time to finish the code, it works for me. How can I adjust your code for my scenario?

Thank you for yor support

Dim lcol a Long
Dim c as long
Dim lrow as Long
Dim rng as Range

'Find last column in row 4
lcol = Cells(4,Columns.Count).End(xlToLeft).Column

'Loop through all columns
For c = 1 to lcol
' Find last row in column
lrow = Cells(Rows.Count,c).End(xlUp).Row
' Set total range in column to search
Set rng = Range(Cells(5,c),Cells(lrow,c))
' Rest of your code to do your replacemetns below


I need to


f RAN.Value = "A/G" Then

Range(Selection, Selection.End(xlDown)).Select

Selection.Offset(1, 0).Replace What:="AA", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Selection.Offset(1, 0).Replace What:="GG", Replacement:="-1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False


Multiple RAN Condition...


Next c
 
Upvote 0
It worked only for the first collumn. Looping through collumns did not work
 
Upvote 0
I mapped out the first few cases for you. You can add the rest (each section would just contain similar code, what is show between the "First case" and "Second case" comments.
VBA Code: 
Sub MyMacro()

    Dim lcol As Long
    Dim c As Long
    Dim lrow As Long
    Dim rng As Range
    Dim cd As String

    Application.ScreenUpdating = False

'   Find last column in row 4
    lcol = Cells(4, Columns.Count).End(xlToLeft).Column

'   Loop through all columns
    For c = 1 To lcol
'       Find last row in column
        lrow = Cells(Rows.Count, c).End(xlUp).Row
'       Set total range in column to search
        Set rng = Range(Cells(5, c), Cells(lrow, c))

'       Get code value in row 4 of column
        cd = Cells(4, c)

'       Determine what to do based on different values
        Select Case cd
'           First case
            Case "A/G"
'               First replacement
                rng.Replace What:="AA", Replacement:="1", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False
'               Second replacement
                rng.Replace What:="GG", Replacement:="-1", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False
'           Second case
            Case "G/T"
'               First replacement
                rng.Replace What:="GG", Replacement:="-1", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False
'               Second replacement
                rng.Replace What:="TT", Replacement:="1", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False
'           etcetera
'               ...
        End Select
    Next c

    Application.ScreenUpdating = True

End Sub
 
Upvote 0
It Worked Perfectly! What amazing help.

I really appreciate your support Joe
 
Upvote 0
You are welcome!

And now that we removed all Select/Selection references, and also suppressed all screen updating until the end, it should run a bit faster too.
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question
Open workbooks in folder and run Macro in each book
Replies
7
Views
325
glynn1969
G
S
  • Solved
userform command button, list box, and check box macro
Replies
7
Views
304
dmt32
D
J
  • Question
Macro to load 10 files from different folder into different sheets in Master File
Replies
2
Views
122
joxyin
J
G
  • Question
Select an Open workbook and apply a macro1 contained in the new book to the new book
Replies
1
Views
110
LazyBug
LazyBug
J
  • Question
another way to speed the macro .
Replies
3
Views
497
Georgiboy
Georgiboy

Forum statistics

Threads
1,214,601
Messages
6,120,460
Members
448,965
Latest member
grijken

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