VBA Looping through range of cells

[MrJamesS]

Hi,

Our multi-site business has Clubs, which are part of defined Regions. Each club has a name e.g. Club A, Club B, Club C etc. We have multiple Regions - Region 1, 2, 3 etc

As part of a piece of work I'm trying to automate, I have an input template which needs to be replicated for each club and saved onto Sharepoint into different folders for different Regions.

My code works fine for everything except for the below

'Set Range of Region 1
    Dim Region1 As Range
    Dim Clubs1 As Range
    Set Region1 = Sheets("Audit").Range("a143:a159")
    For Each Clubs1 In Region1
    Region1club = Clubs1.Value
    
'Save file as each club name on Sharepoint, changing the dropdown box each time

   Worksheets("Audit").Activate
   Range("B3").Value = Region1club
   ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ("username") & "\" & SharepointLocation & "\" & Region1club & ".xlsm"

'Loop through rest of Region 1

   Next Clubs1

This loops until finished with the range and then starts with the next Region and so on

Where the range is defined within A143:A159 (the range being Club A, B, C etc), I also want to input the club name within Cell B3. However for the 1st club in the range (A143), it is inputting the 2nd club instead (A144) into Cell B3. The strange thing is it saves the file with the correct name (A143). So it does the 2nd part correct, but not the 1st part.

Each club name in cell B3 is therefore out by 1 in the range. The file of the last club in the range is correct however.

Any ideas?

 

[rlv01]

Perhaps something like this that more explicitly qualifies your range and worksheet references.

'Set Range of Region 1
    Dim Region1 As Range
    Dim Clubs1 As Range

    With ThisWorkbook.Worksheets("Audit")
        .Activate
        Set Region1 = .Range("a143:a159")

        'Save file as each club name on Sharepoint, changing the dropdown box each time
        For Each Clubs1 In Region1
            Region1club = Clubs1.Value
            .Range("B3").Value = Clubs1.Value
            With ActiveWorkbook
                .SaveCopyAs Filename:="C:\Users\" & Environ("username") & "\" & SharepointLocation & "\" & Region1club & ".xlsm"
                DoEvents
            End With
            'Loop through rest of Region 1
        Next Clubs1
    End With