Repeat code through for loop giving error

earthworm

Active Member
Joined
May 19, 2009
Messages
368
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
I want the below code to repeat 38 times . I have also mapped all variable reference but still its not working
please help what am i doing wrong in this code

VBA Code:
Sub Split8()

Windows("Raw Report Under Construction.xlsb").Activate

Sheets("DB").Select

Dim x As Integer
For x = 1 To 38

Dim Filter As String
Filter = Range("G" & x).Value

Dim Filename As String
Filename = Range("H" & x).Value

Dim reference As Integer
reference = Range("I" & x).Value

    Sheets("DB").Select
    If reference > 0 Then
    Sheets("Sheet1").Select
    Rows("1:1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AF$26443").AutoFilter Field:=4, Criteria1:=Filter
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.Columns.AutoFit
    Columns("A:A").Select
    Selection.NumberFormat = "General"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(R2C[3]:RC[3],RC[3])"
    Range("A2").Copy
    Range("A2:A" & Range("B" & Rows.Count).End(xlUp).Row).PasteSpecial
    Range("A2:A" & Range("B" & Rows.Count).End(xlUp).Row).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
    ActiveWindow.FreezePanes = True
    Range("A1").Select
            Sheets("Sheet1").name = Filter
        ChDir "C:\Users\iiiii\OneDrive\Desktop\Test"
    ActiveWorkbook.SaveAs Filename:=Filename, _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    
    ActiveWorkbook.Close
    Windows("Raw Report Under Construction.xlsb").Activate
    Range("A1").Select
    Selection.AutoFilter
    End If
    Next x
    End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,794
Office Version
  1. 365
Platform
  1. Windows
For the 2nd iteration onwards, your code is look at I2 on Sheet1 not on DB.
You need to move the 1st line here so that it's after the loop
VBA Code:
Sheets("DB").Select

Dim x As Integer
For x = 1 To 38
 

Some videos you may like

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

earthworm

Active Member
Joined
May 19, 2009
Messages
368
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
For the 2nd iteration onwards, your code is look at I2 on Sheet1 not on DB.
You need to move the 1st line here so that it's after the loop
VBA Code:
Sheets("DB").Select

Dim x As Integer
For x = 1 To 38
its already mentioned in previous code please check despite of which its giving error . can you please share the change in below.

VBA Code:
Sub Split8()

Windows("Raw Report Under Construction.xlsb").Activate

Sheets("DB").Select

Dim x As Integer
For x = 1 To 38

Dim Filter As String
Filter = Range("G" & x).Value

Dim Filename As String
Filename = Range("H" & x).Value

Dim reference As Integer
reference = Range("I" & x).Value

    Sheets("DB").Select
    If reference > 0 Then
    Sheets("Sheet1").Select
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,794
Office Version
  1. 365
Platform
  1. Windows
Just move the line I mention so that it comes straight after the start of the loop.
 

earthworm

Active Member
Joined
May 19, 2009
Messages
368
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Just move the line I mention so that it comes straight after the start of the loop.
ohh my god it actually worked . Hail to you sir . !! I thought loop will start from 1st line of sub but i didnt knew that it works after variable of for loop
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,794
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,128,129
Messages
5,628,865
Members
416,347
Latest member
AT2021

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top