Help with VBA coding

[yitm03]

Hi there, Stuck with an issue for over a week and need someone to point me in the right direction. I recorded a macro to do a advanced filter and copy the data to another sheet. Works great with one drawback! I have over 3000 rows and created Do While Loop to get the values into 2 different columns but the macro had a fixed range from doing it manually and obviously it just creates 3000 sheets with the same value.
Sub calcModO()
Dim row As Integer
row = 2

Do While Cells(row, 6) <> ""
Cells(row, 7).Value = Cells(row, 9).Value * 0.85
Cells(row, 8).Value = Cells(row, 9).Value * 1.15

Sheets.Add After:=ActiveSheet
Range("A1").Select

Sheets("sheet1").Range("A1:AF1262").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("DIA (4)").Range("G2:H2"), CopyToRange:=Range( _
"A1"), Unique:=False

row = row + 1
Loop

End Sub

How can I, in the loop have the CriteriaRange:=Sheets("sheet1").Range("G2:H2"), change to the next row ("G3:H3")? Do I need to call on a procedure or can it be done within the code above?
Thanks for any much needed hep.

[MINCUS1308]

loop through your data changing the values

MyRow = 2
     Do While Cells(row, 6) <> ""
          Cells(MyRow, 7).Value = Cells(MyRow, 9).Value * 0.85
          Cells(MyRow, 8).Value = Cells(MyRow, 9).Value * 1.15
     row = row + 1
     Loop

and then add the new sheet,

Sheets.Add After:=ActiveSheet
     ActiveSheet.Range("A1").Select        
     Sheets("sheet1").Range("A1:AF1262").AdvancedFilter...

otherwise you'll end up with 3000 sheets

or
create the sheet and then loop through your data
adding data to your new worksheet as you go

MyRow = 2
Sheets.Add After:=ActiveSheet

     Do While Cells(row, 6) <> ""
          Cells(MyRow, 7).Value = Cells(MyRow, 9).Value * 0.85
          Cells(MyRow, 8).Value = Cells(MyRow, 9).Value * 1.15

          'do other stuff here
     row = row + 1
     Loop

[MINCUS1308]

It seems like you want to update columns 7 & 8 for all 3000 rows
and create a copy (if it meets criteria on Sheets("DIA (4)").Range("G:H") ) of that data on a new spreadsheet?

It may be simpler to just check Sheets("DIA (4)").Range("G:H") for each row

Something like:

Sub calcModO()
     
     Sheets.Add After:=ActiveSheet
     
     MyRow = 2
     Do While Sheet1.Cells(MyRow, 6) <> ""
          Sheet1.Cells(MyRow, 7).Value = Sheet1.Cells(MyRow, 9).Value * 0.85
          Sheet1.Cells(MyRow, 8).Value = Sheet1.Cells(MyRow, 9).Value * 1.15
          
          If ((Sheet1.Cells(MyRow, 7).Value = Sheets("DIA (4)").Cells(MyRow, 7).Value) _
               And (Sheet1.Cells(MyRow, 8).Value = Sheets("DIA (4)").Cells(MyRow, 8).Value)) Then
               
               I = 1
               Do Until ActiveSheet.Cells(I, 1) = ""
               I = I + 1
               Loop
               
               ActiveSheet.Cells(I, 7).Value = Sheet1.Cells(I, 1).Value
               ActiveSheet.Cells(I, 8).Value = Sheet1.Cells(I, 2).Value
          
          End If
     
     MyRow = MyRow + 1
     Loop
End Sub

[yitm03]

Thank you for your quick response. The point is I need to have the 3000 sheets to import into another program to do back testing over 12 years with the data. I was doing it manually sheet by sheet and than saving as CSV file to import to the other program. So the solution is not what I was looking for but thanks for your help regardless. I already have the modules to save as CSV and delete the 2999 sheets created.

[SamT]

Add all the new data to the sheet.
Save that sheet as CSV.
That Sheet.Cells.Clear.
Repeat

I counted Column Letters on my fingers, so double check.
Not compiled, Not tested

Sub calcModO()
Dim Sht! As Worksheet
Dim ShtA As Worksheet
Dim DIA As Worksheet
Dim Rw As Long 'Always declare Row and column Counters as Long
Dim LR As Long

LR = Sheets("sheet1").Cells(Rows.Count, "G").End(xlUp).Row
Rw = 2 '"Row" is a Keyword and using it as a variable can "Confuse" VBA.
Set DIA = Sheets("DIA (4)")

Application.ScreenUpdating = False 'Uncomment Line after testing

Sheets.Add
Set ShtA = ActiveSheet

For Rw = 2 to LR
With Sht1
Cells(RW, "G") = Cells(Rw, "J") * 0.85
Cells(Rw, "I") = CellsRw, "J").Value * 1.15

.Range("A1:AF1262").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=DIA.Range(Cells(Rw, "G"), Cells(Rw, "H")), _
CopyToRange:=ShtA.Range("A1"),Unique:=False
End with

CSVModule.SaveAsCSV ShtA 'Edit to suit
ShtA.Cells.Clear
Next

Application.Display Alerts = False
ShtA.Delete
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub