If cell equals then run macro-CodePudding

I have a vba code which do almost what I want. It creates a new workbook based on a template and saves it with the correct name based on a list. However, I only want the code to create the workbooks IF a statement is true. I'm very new to VBA so please bear with me.

See following example:

Sheet "MC_TestSheetGenerator"

When i run the macro ONE_CreateTestsheetWB_TEST_NEW_INST_01 it creates new workbooks based on a template i have called "TEST-NEW-INST-01" and saves the file with the name in col "I" of the "MC_TestSheetGenerator".

How can I tell the script, only to do that if the adjecent cell H equals "TEST-NEW-INST-01"? - e.g. in this example it shall only have create two new workbooks as the values is only present in row 3 and 8.

Thanks you in advance!

Macro ONE_CreateTestsheetWB_TEST_NEW_INST_01

    Sub ONE_CreateTestsheetWB_TEST_NEW_INST_01()
Application.DisplayAlerts = False
Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets("MC_TestSheetGenerator") 'Edit sheet name
lr = sh1.Cells(Rows.Count, "I").End(xlUp).Row
Set rng = sh1.Range("I3:I" & lr)
    For Each c In rng
        Sheets("TEST-NEW-INST-01").Copy 'Edit sheet name
        Set wb = ActiveWorkbook
        wb.Sheets(1).Range("A3") = c.Value
        wb.SaveAs ThisWorkbook.Path & "\" & c.Value & ".xlsx", 51
        wb.Close False
        Application.DisplayAlerts = True
    Next
End Sub

CodePudding user response：

Inside your For loop just add an If statement using property OFFSET :

For Each c In Rng
    If c.Offset(0, -1).Value = "TEST-NEW-INST-01" Then
        Sheets("TEST-NEW-INST-01").Copy 'Edit sheet name
        Set wb = ActiveWorkbook
        wb.Sheets(1).Range("A3") = c.Value
        wb.SaveAs ThisWorkbook.Path & "\" & c.Value & ".xlsx", 51
        wb.Close False
        Application.DisplayAlerts = True
    End If
Next

Range.Offset property (Excel)

Also, as advice, I'm pretty sure your Application.DisplayAlerts = True could be outside of the loop.

CodePudding user response：

OFFSET property will be the easiest way to introduce it in your code OR you can change the loop type and loop directly in that column and check the condition after.

Also, I agree with @Foxfire And Burns And Burns, the Application.DisplayAlerts = True should be set outside the loop, preferably at the end of the code/sub.

I have revamped your code, please have a look:

Sub ONE_CreateTestsheetWB_TEST_NEW_INST_01()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim wb, wbnew As Workbook
Dim sh1 As Worksheet, lr As Long, rng As Range
Set wb = ThisWorkbook
Set sh1 = wb.Sheets("MC_TestSheetGenerator")
lr = sh1.Cells(Rows.Count, "I").End(xlUp).Row

For i = 3 To lr
    If sh1.Range("H" & i).Value2 = "TEST-NEW-INST-01" Then
        Set wbnew = Workbooks.Add
        wb.Sheets("TEST-NEW-INST-01").Copy Before:=wbnew.Sheets(1)
        wbnew.SaveAs wb.Path & "\" & sh1.Range("I" & i).Value2, FileFormat:=51
        wbnew.Close
    End If
Next i

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub