CODEWITHSUNDEEP
excelvba
Binnnnn5
Binnnnn5

Reputation: 187

How to use a larger loop to finish multiple task instead of 14 loops?

There is a need for searching 14 columns and copy those 14 columns to another destination from a excel with over 100 columns in it.

I have successfully finished this task by using 14 "For" loops. I wonder if there is any solutions to accomplish this task by using a large loop instead of 14 small loops?

It would be really helpful if any one could show me how to do this. Thank you very much!

If merging 14 loops is too boring for you, try to show me by merging 3 of the small loops instead is also helpful. Thanks!

' Search for "Project Code CSO"
For Each Rng In Range("a1:fi1")
    If Rng = "Project Code CSO" Then
        f_1 = Rng.Column
    End If
Next
Columns(f_1).Copy Destination:=Sheets(7).Columns("A")

' Search for "Code"
For Each Rng In Range("a1:fi1")
    If Rng = "Code" Then
        f_2 = Rng.Column
    End If
Next
Columns(f_2).Copy Destination:=Sheets(7).Columns("B")

' Search for "Study Desc"
For Each Rng In Range("a1:fi1")
    If Rng = "Study Desc" Then
        f_3 = Rng.Column
    End If
Next
Columns(f_3).Copy Destination:=Sheets(7).Columns("C")

' Search for "Study Phase"
For Each Rng In Range("a1:fi1")
    If Rng = "Study Phase" Then
        f_4 = Rng.Column
    End If
Next
Columns(f_4).Copy Destination:=Sheets(7).Columns("D")

' Search for "Regions/countries List"
For Each Rng In Range("a1:fi1")
    If Rng = "Regions/countries List" Then
        f_5 = Rng.Column
    End If
Next
Columns(f_5).Copy Destination:=Sheets(7).Columns("E")

' Search for "? RTM Study"
For Each Rng In Range("a1:fi1")
    If Rng = "? RTM Study" Then
        f_6 = Rng.Column
    End If
Next
Columns(f_6).Copy Destination:=Sheets(7).Columns("F")

' Search for "Cent."
For Each Rng In Range("a1:fi1")
    If Rng = "Cent." Then
        f_7 = Rng.Column
    End If
Next
Columns(f_7).Copy Destination:=Sheets(7).Columns("G")

' Search for "Pat."
For Each Rng In Range("a1:fi1")
    If Rng = "Pat." Then
        f_8 = Rng.Column
    End If
Next
Columns(f_8).Copy Destination:=Sheets(7).Columns("H")

' Search for "Pat/Cent"
For Each Rng In Range("a1:fi1")
    If Rng = "Pat/Cent" Then
        f_9 = Rng.Column
    End If
Next
Columns(f_9).Copy Destination:=Sheets(7).Columns("I")

' Search for "FPI Planned Start"
For Each Rng In Range("a1:fi1")
    If Rng = "FPI Planned Start" Then
        f_10 = Rng.Column
    End If
Next
Columns(f_10).Copy Destination:=Sheets(7).Columns("J")

' Search for "LPI/LSI planned Date"
For Each Rng In Range("a1:fi1")
    If Rng = "LPI/LSI planned Date" Then
        f_11 = Rng.Column
    End If
Next
Columns(f_11).Copy Destination:=Sheets(7).Columns("K")

' Search for "LPLV/LSLV planned start date"
For Each Rng In Range("a1:fi1")
    If Rng = "LPLV/LSLV planned start date" Then
        f_12 = Rng.Column
    End If
Next
Columns(f_12).Copy Destination:=Sheets(7).Columns("L")

' Search for "DBL-FPI"
For Each Rng In Range("a1:fi1")
    If Rng = "DBL-FPI" Then
        f_13 = Rng.Column
    End If
Next
Columns(f_13).Copy Destination:=Sheets(7).Columns("M")


' Search for "DBL planned start"
For Each Rng In Range("a1:fi1")
    If Rng = "DBL planned start" Then
        f_14 = Rng.Column
    End If
Next
Columns(f_14).Copy Destination:=Sheets(7).Columns("N")

Sheets(7).Select

I'm a new learner for VBA, and I wish to know how to merge those small loop together by using a single large loop. :-)

Upvotes: 0

Views: 60

Answers (2)

John Coleman
John Coleman

Reputation: 52008

You have repetitive code repeated 14 times in a row. That is a good indication that this code belongs in a loop (which would make the overall structure a nested loop). Something like:

Sub test()
    Dim Rng As arange
    Dim criteria As Variant, targets As Variant
    Dim i As Long, f_1 As Long

    criteria = Array("Project Code CSO", "Code", "Study Desc", "Study Phase", "Regions/countries List", _
                     "? RTM Study", "Cent.", "Pat.", "Pat/Cent", "FPI Planned Start", _
                     "LPI/LSI planned Date", "LPLV/LSLV planned start date", _
                     "DBL-FPI", "DBL planned start")

    targets = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")

    For i = 0 To 13
        f_1 = 0
        For Each Rng In Range("a1:fi1")
            If Rng = criteria(i) Then
                f_1 = Rng.Column
            End If
        Next
        'In practice, you shouldn't assume you found what you seek, but optimistically:
        Columns(f_1).Copy Destination:=Sheets(7).Columns(targets(i))
    Next i

End Sub

Upvotes: 1

Pᴇʜ
Pᴇʜ

Reputation: 57743

The following should do it. You need to add the other cases, I just gave 3 examples:

Option Explicit

Public Sub CopyColumns()
    Dim Col As String

    Dim Rng As Range
    For Each Rng In Range("A1:FI1")

        Select Case Rng.Value
            Case "Project Code CSO":    Col = "A"
            Case "Code":                Col = "B"
            Case "Study Desc":          Col = "C"

            'put your other cases here

            Case Else: Col = vbNullString
        End Select

        If Col <> vbNullString Then
            Rng.EntireColumn.Copy Destination:=Sheets(7).Columns(Col)
        End If
    Next Rng
End Sub

Upvotes: 3

Related Questions