Revise current macro (SOLVED)

[hazzaska]

Hi All

Can anyone tell me how to revise this macro to run based on a value entered into sheet "PasteDataHere" Cell T1? It currently works by the entry in red

Thanks

Sub Race()
'
' Macro5 Macro
'
Application.ScreenUpdating = False
'Let x = 0
Do While x < 10
    Sheets("PasteDataHere").Select
    Range("A1:K49").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Range("A11").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("PasteDataHere").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Sheets("Sheet3").Select
    Range("M1").Select
    Call GreyCalc
    x = x + 1
Loop
End Sub

[Sa DQ]

 Dim X As Byte
Do While x < 10
    Sheets("PasteDataHere").Select
    Range("A1:K49").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Range("A11").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("PasteDataHere").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Sheets("Sheet3").Select
    Range("M1").Select
    Call GreyCalc
    x = x + 1
    If X >= Sheets("PasteDataHere").[T1].Value Then Exit Do  '<=|'
Loop 

[Trebor76]

Hi hazzaska,

Untested, but see how this goes:

Sub Race()
'
' Macro5 Macro
'
Application.ScreenUpdating = False
'Let x = 0
x = Sheets("PasteDataHere").Range("T1").Value
Do While x < 10
    Sheets("PasteDataHere").Select
    Range("A1:K49").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Range("A11").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("PasteDataHere").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Sheets("Sheet3").Select
    Range("M1").Select
    Call GreyCalc
    x = x + 1
Loop
End Sub

HTH

Robert

[hazzaska]

Hi Thanks for the responses i tailored your solution Trebor76 to this and it works if i manually enter it, can it be done if the value in "paste data here" T1 comes from a formula or even can the macro run until there is no data left in the "paste data here" sheet"

Heres the one that works if i manually enter a value in T1

Sub Race()
'
' Macro5 Macro
'
Application.ScreenUpdating = False
'Let x = 0
Do While X < Sheets("PasteDataHere").Range("T1").Value
    Sheets("PasteDataHere").Select
    Range("A1:K49").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Range("A11").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("PasteDataHere").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Sheets("Sheet3").Select
    Range("M1").Select
    Call GreyCalc
    X = X + 1
Loop
End Sub

Thanks again much appreciated.

[Trebor76]

can it be done if the value in "paste data here" T1 comes from a formula

Yes, however the value in cell T1 gets there it will work.

[hazzaska]

Yes, however the value in cell T1 gets there it will work.

Thanks for your help Trebor76 it works a treat i had to adjust the following in red otherwise it would run the macro half the amount of times

Cheers

Sub Race()
'
' Macro5 Macro
'
Application.ScreenUpdating = False
'Let x = 0
Do While X < Sheets("PasteDataHere").Range("T1").Value
    Sheets("PasteDataHere").Select
    Range("A1:K49").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Range("A11").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("PasteDataHere").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Sheets("Sheet3").Select
    Range("M1").Select
    Call GreyCalc
    X = X + 0
Loop
End Sub

[Trebor76]

Glad it's all sorted

If you could mark the the thread as solved when you get a moment it would be appreciated.

Robert