Help with looping a Macro

[amera]

Hi,

I am trying to calculate the 3D distance between the cells in range A1:V3579 and those in X1:AS4860.

For each row in the first range, calculate the distance between that and all points in the second range, I find the minimum of all the data in AT and copy that row in the range to a separate sheet- I go down each row in the first range and compare with all cells in AT to find the minimum and past beneath the prior minimum in the new sheet.

The macro i developed however...does not work.

Sub Macro2()
'
' Macro2 Macro
'

'
Range("AT2").Select
For I = 1 To 3578
    ActiveCell.FormulaR1C1 = _
        "=((((R[I+1]C[-44]-RC[-21])^2)+((R[I+1]C[-32]-RC[-9])^2)+((R[I+1]C[-31]-RC[-8])^2))^0.5)"
    
    
    Selection.AutoFill Destination:=Range("AT2:AT4860")
    Range("AT2:AT4860").Select
     Range("AU2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=MIN(RC[-1]:R[4858]C[-1]),1,0)"
    Range("AU2").Select
    Selection.AutoFill Destination:=Range("AU2:AU4860")
    Range("AU2:AU4860").Select
    Range("A22:AU22").Select
    Range("AU22").Activate
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Next I
End Sub

Any help on this will be appreciated.

 

[jproffer]

How does it "not work"? There will never be what you called a prior minimum in the other sheet. You're creating a new sheet for every "I". I'm not sure if there's a maximum number of sheets in a workbook, but it may very well be less than 3578.

Anyhow, barring any worksheet limits..what is it doing or not doing that's different from what you expected/hoped for/needed?

Also you're copying a range, and then creating the new sheet, and trying to paste without specifying what range you want to paste into.

 

[amera]

hmmm...Well maybe I have coded it wrong then.

I am not trying to create a new sheet for each minimum I-just a sheet where all I minimums shall be pasted.

The recorded macro runs but only copies the value for the first minimum distance for the locations in row 2. I tried updating the recorded macro with ...for I=1 to 3578 but the code gives a runtime error 1004.

 

[jproffer]

Test this on a COPY of your workbook and see if it does what you want it to do...

Sub Macro2()
Dim LR As Long
Dim I As Long

Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Summary"
LR = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Row + 1


For I = 1 To 3578
    With Range("AT2")
        .FormulaR1C1 = "=((((R[I+1]C[-44]-RC[-21])^2)+((R[I+1]C[-32]-RC[-9])^2)+((R[I+1]C[-31]-RC[-8])^2))^0.5)"
        .AutoFill Destination:=Range("AT2:AT4860")
    End With
         
    With Range("AU2")
        .FormulaR1C1 = "=IF(RC[-1]=MIN(RC[-1]:R[4858]C[-1]),1,0)"
        .AutoFill Destination:=Range("AU2:AU4860")
    End With

Range("A22:AU22").Copy
    
Sheets("Summary").Range("A" & LR).PasteSpecial Paste:=xlPasteValues

Next I
End Sub