Run a loop depending on a cell value

[hamistasty]

I'm running this loop which works great thanks to Alpha:

Sub FIC001()
    
    Dim ws As Worksheet, Lastrow As Long, i As Long
    
    Sheets("FIC001").Visible = True
    
    Set ws = Sheets("FIC001")       
    With Sheets("Schedule")          
   
        .Range("B1").Copy ws.Range("B4:E4")
        .Range("B2").Copy ws.Range("B5:E5")
        .Range("B3").Copy ws.Range("G4:J4")
        
        Lastrow = .Range("C" & Rows.Count).End(xlUp).Row
        For i = 5 To Lastrow
            
            .Range("A" & i).Copy ws.Range("G14:J14")
            .Range("B" & i).Copy ws.Range("B14:E14")
            .Range("C" & i).Copy ws.Range("G11:J11")
            .Range("D" & i).Copy ws.Range("B11:E11")
            .Range("E" & i).Copy ws.Range("G10:H10")
            .Range("F" & i).Copy ws.Range("B10:E10")
            .Range("G" & i).Copy ws.Range("J10")
            .Range("H" & i).Copy ws.Range("B7:E7")
            .Range("I" & i).Copy ws.Range("G7:J7")
            .Range("J" & i).Copy ws.Range("B15:E15")
            .Range("K" & i).Copy ws.Range("B8:J8")
            
            ws.Copy After:=Sheets(Sheets.Count)
            
            Sheets(Sheets.Count).Name = .Range("C" & i) & " " & "-" & " " & .Range("J" & i).Value
            
        
        Next i
        
     End With
    
      ws.Range("B4:E4, B5:E5, G4:J4, G14:J14, B14:E14, G11:J11, B11:E11, J10, " & _
             "G10:H10, B10:E10, B7:E7, G7:J7, B15:E15, B8:J8").ClearContents
             
              Sheets("FIC001").Visible = False
        
          Sheets(1).Select
             
End Sub

Which basically copies a row of data into a copied template sheet and loops until there are no rows left.

What I'm asking for is code so that before it starts it checks column A for FIC001 to FIC040, and if for example the cells value is FIC001 then it will run the FIC001 loop above.

Thanks!

 

[g4cox]

Hi,

I would do this (I am sure there are better ways but....) put FIC001-FIC040 in say column F then do a Vlookup in column G (=VLOOKUP(F1,A:A,1,FALSE) then use the code below.<o></o>
Hopefully this is what you were after?

Sub FIC001()

    Dim ws As Worksheet, Lastrow As Long, i As Long

    Sheets("FIC001").Visible = True

    Set ws = Sheets("FIC001")
    With Sheets("Schedule")

        If Application.WorksheetFunction.CountIf(Range("G:G"), "#N/A") = 40 Then
        MsgBox ("No Data Close Macro")
        Else

        .Range("B1").Copy ws.Range("B4:E4")
        .Range("B2").Copy ws.Range("B5:E5")
        .Range("B3").Copy ws.Range("G4:J4")

        Lastrow = .Range("C" & Rows.Count).End(xlUp).Row
        For i = 5 To Lastrow

            .Range("A" & i).Copy ws.Range("G14:J14")
            .Range("B" & i).Copy ws.Range("B14:E14")
            .Range("C" & i).Copy ws.Range("G11:J11")
            .Range("D" & i).Copy ws.Range("B11:E11")
            .Range("E" & i).Copy ws.Range("G10:H10")
            .Range("F" & i).Copy ws.Range("B10:E10")
            .Range("G" & i).Copy ws.Range("J10")
            .Range("H" & i).Copy ws.Range("B7:E7")
            .Range("I" & i).Copy ws.Range("G7:J7")
            .Range("J" & i).Copy ws.Range("B15:E15")
            .Range("K" & i).Copy ws.Range("B8:J8")

            ws.Copy After:=Sheets(Sheets.Count)

            Sheets(Sheets.Count).Name = .Range("C" & i) & " " & "-" & " " & .Range("J" & i).Value


        Next i

     End With

      ws.Range("B4:E4, B5:E5, G4:J4, G14:J14, B14:E14, G11:J11, B11:E11, J10, " & _
             "G10:H10, B10:E10, B7:E7, G7:J7, B15:E15, B8:J8").ClearContents

              Sheets("FIC001").Visible = False

          Sheets(1).Select
    End If

End Sub

<o></o>

 

[hamistasty]

To be clear, what I want to do is:

In column G, there is a value ranging from FIC001 to FIC040 (for example, it could be FIC023.) When I press a button, a macro checks what value is in column G for each row and runs the corresponding code inside the loop.

So, if I have 5 rows of data that has FIC001, FIC004, FIC010, FIC001, FIC0010. It will see FIC001, and then copy&paste using the FIC001 Tab as the template, then see FIC004 and again use the FIC004 tab to copy and paste to, and so forth.

I assume this means an If statement stateing "If column G + i = FIC001 then continue, Else go to FIC002.." ... "If column G + i = FIC002 then continue, Else go to FIC003" etc. etc.

Does that make sense? Also I get an error on the End With just before the End Sub using that code above.

 

[hamistasty]

So what I was thinking is the button macro runs through each row, and if Column A, row i has FIC001 it will run FIC001 macro for that row, or if it's FIC002 it will run the FIC002 macro. Is that a better way to do it? Can anyone fix this code so it works?

button macro:

' ASSIGNS THE FIC TO USE FOR EACH ROW
Sub createmanager()
 Dim ws As Worksheet, Lastrow As Long, i As Long
  With Sheets("Schedule")
 
  Lastrow = .Range("D" & Rows.Count).End(xlUp).Row
 
        For i = 5 To Lastrow
 
         If Selection.Value = "FIC001" Then
                         Application.Run "WORKPACK CREATOR.xlsm!FIC001"
                  ElseIf Selection.Value = "FIC002" Then
                             Application.Run "WORKPACK CREATOR.xlsm!FIC002"
                  End If
Next i
    End With
End Sub

FIC001 example:

' FIC001 creation
Sub FIC001()
 
    'unhides FIC template
    Sheets("FIC001").Visible = True
 
    Set ws = Sheets("FIC001")   ' Copy to FIC TEMPLATE 001
    With Sheets("Schedule")       ' Copy from worksheet
 
        ' These cells are the same on each worksheet copy
        .Range("C1").Copy ws.Range("B4:E4")
        .Range("C2").Copy ws.Range("B5:E5")
        .Range("C3").Copy ws.Range("G4:J4")
 
        ' These cells are copied from each row (row 5 to the last used row).
 
            .Range("B" & i).Copy ws.Range("G14:J14")
            .Range("C" & i).Copy ws.Range("B14:E14")
            .Range("D" & i).Copy ws.Range("G11:J11")
            .Range("E" & i).Copy ws.Range("B11:E11")
            .Range("F" & i).Copy ws.Range("G10:H10")
            .Range("G" & i).Copy ws.Range("B10:E10")
            .Range("H" & i).Copy ws.Range("J10")
            .Range("I" & i).Copy ws.Range("B7:E7")
            .Range("J" & i).Copy ws.Range("G7:J7")
            .Range("K" & i).Copy ws.Range("B15:E15")
            .Range("L" & i).Copy ws.Range("B8:J8")
 
            ' names the tab as the corresponding cable number
            Sheets(Sheets.Count).Name = .Range("D" & i).Value
 
    End With
 
      'clears FIC template
         ws.Range("B4:E4, B5:E5, G4:J4, G14:J14, B14:E14, G11:J11, B11:E11, J10, " & _
             "G10:H10, B10:E10, B7:E7, G7:J7, B15:E15, B8:J8").ClearContents
 
      'hides FIC templates
        Sheets("FIC001").Visible = False
        ' Returns to the first sheet/schedule
          Sheets(1).Select
 
End Sub

That FIC001 code is all messed up now because of i

 

[hamistasty]

bump