Run one macro on multiple ranges in a single worksheet

[LittleGriff]

Hi, and thanks in advance. I have a macro that merges a two-column range in my worksheet. Right now I'm duplicating and editing the macro for multiple ranges of columns, because the macro is appropriate for about 10 ranges in my worksheet, maybe more.

Is there a way to add a "For Each Range..." type loop to specify each pair of columns that will be joined/merged? Here's the macro (it's rudimentary; I'm a beginner). Any place there's a string variable or a column letter, would be where I would like to substitute a placeholder of some sort so the macro will run on every pair of "qualifying" columns.

Thanks again!

<code>

Sub PreferredReturnPercent() 'PreferredReturnPercent and PreferredReturnType columns DG and DH
' format 0.00% (text details)
 
Application.ScreenUpdating = False
Dim startRow As Long
Dim lastRow As Long
Dim i As Long 'counter to loop through cells
Dim prefRetPct As String 'text of the 1st column contents
Dim prefRetType As String ' text of the 2nd column contents
 
startRow = 2
lastRow = Sheets("SheetName").Cells(Sheets("SheetName").Rows.Count, 1).End(xlUp).Row

For i = startRow To lastRow
 
    prefRetPct = Sheets("SheetName").Range("DG" & i).Value
    prefRetType = Sheets("SheetName").Range("DH" & i).Value
   
    If prefRetPct <> "" And prefRetType <> "" Then
 
newString = Format(Worksheets("SheetName").Range("DG" & i).Value, "0.00%") & vbNewLine & " (" & Worksheets("SheetName").Range("DH" & i).Value & ")"
   
Worksheets("SheetName").Range("DG" & i).Value = newString 'write the new string to the first column; second column to be deleted later
 
Range("DG:DG").HorizontalAlignment = xlCenter

Else
End If
Next 
Application.ScreenUpdating = True
End Sub

</code>

 

[LittleGriff]

I'm posting the solution I received in another forum, in case it helps somebody else. The idea is, in a large sheet where several non-contiguous two-column ranges exist, perform the same join and format task on each pair of columns. My savior on Reddit suggested making all the first columns into one array, and the second columns into a second array. Genius!

Sub Percent_Text_In_Parens_Format() ' format 0.00% (text details)


Application.ScreenUpdating = False
Dim startRow As Long
Dim lastRow As Long
Dim i As Long 'counter to loop through cells
Dim columnOne As String 'text of the 1st column contents
Dim columnTwo As String ' text of the 2nd column contents
Dim firstArray, secondArray As Variant ' Arrays to hold the two lists of columns
Dim stpr, arrayLen As Long


startRow = 2
lastRow = Sheets("name").Cells(Sheets("name").Rows.Count, 1).End(xlUp).Row
firstArray = Array("AX", "DG") ' This is the list of columns that contain the first value to be joined
secondArray = Array("AY", "DH") ' This is the list of columns that contain the second value to be joined
arrayLen = UBound(firstArray) - LBound(firstArray)


For stpr = 0 To arrayLen


    For i = startRow To lastRow


        columnOne = Sheets("name").Range(firstArray(stpr) & i).Value
        columnTwo = Sheets("name").Range(secondArray(stpr) & i).Value


        If columnOne <> "" And columnTwo <> "" Then


            newString = Format(Worksheets("name").Range(firstArray(stpr) & i).Value, "0.00%") & vbNewLine & " (" & Worksheets("name").Range(secondArray(stpr) & i).Value & ")"
            Worksheets("name").Range(firstArray(stpr) & i).Value = newString 'write the new string to the first column; ' second column to be deleted later
            Columns(firstArray(stpr)).HorizontalAlignment = xlCenter


        End If


    Next i


Next stpr


Application.ScreenUpdating = True
End Sub

 

[Fluff]

Thanks for supplying the solution, but for future reference
While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

 

[LittleGriff]

Thank you for this information! Shall I add the link to the Reddit thread now? Glad to do so.

 

[Fluff]

As you have already supplied the solution there is no need on this occasion.
But if you cross post in future, please supply the links teling us that you have done so.