Help with VBA

[Mike7777]

I am working on a spread sheet that in one specific cell(we'll say Sheet1 A1) I need it to display another cell on another page(Sheet2 B36). Thats easy enough, but then at each calculation I need the cell above the original cell that was being displayed to be displayed (so now its displaying Sheet2 B35 in Sheet1 A1) and at each calculation after go up one cell each time.
Is this possible? I've tried googling this and I can't find anything.
Thanks for any help
Much Appreciated
Mike

edit, There will be no formula in Sheet1 A1 I just need it to display the value of Sheet 2 then up one per calculation.

 

[offthelip]

By the sound of your description what you want to do is recalculate a worksheet 1000 times while changing the value in sheet1 A1 to a different value each iteration which is picked up from sheet2 . I still don't quite understand why you start with B36 for 1000 iterations when you only have 36 different inputs. However this is one way which might help you "integrate" my code with yours. This way you don't need to put anything into the worksheet calculate routine. Note I stopped at row 2 because I presumed there was a header row

Sub NETWORK()
'
' NETWORK Macro
'




'
Dim k As Integer
k = 0


currow = 36
Cells(1, 1) = Worksheets("Sheet2").Range("B" & currow)
For i = 1 To 1000
Calculate
If currow > 2 Then
 currow = currow - 1
End If
Cells(1, 1) = Worksheets("Sheet2").Range("B" & currow)


Range("V8:AC33").Select
Application.CutCopyMode = False
Selection.Copy
Range("B8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If Cells(1, 1) = 1 Then k = k + 1








Next i


Cells(2, 1) = k

 

[Mike7777]

offthelip thank you very much. And your right. I'm not gonna start at 36. I'm gonna start at probably more like 6000. It takes a lot of calculations for the machine learning to be accurate. I was just posing a generic idea up in hopes someone could help. Thank you
I have another question though. I hate to keep bothering. But I have I think 5 cells total that I have to pull from another page in the same manner to completely set up the demographic. Do I just repeat what you have done? something like this?

Sub NETWORK()
'
' NETWORK Macro
'




'
Dim k As Integer
k = 0


currow = 36
Cells(1, 1) = Worksheets("Sheet2").Range("B" & currow)

currow = 36
Cells(1, 2) = Worksheets("Sheet2").Range("C & currow)
For i = 1 To 1000
Calculate
If currow > 2 Then
 currow = currow - 1
End If
Cells(1, 1) = Worksheets("Sheet2").Range("B" & currow)
If currow > 2 Then
currow = currow -1
End If
Cells(1, 2) = Worksheets("Sheet2").Range("c" & currow)
Range("V8:AC33").Select
Application.CutCopyMode = False
Selection.CopyRange("B8").SelectSelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If Cells(1, 1) = 1 Then k = k + 1
Next i
Cells(2, 1) = k

 

[offthelip]

there bits that you repeat and there are bits that you musn't repeat, I have annotated the code accordingly:

Sub NETWORK()
'
' NETWORK Macro
'
'
Dim k As Integer
k = 0

' you only need to initialise this once
currow = 36
'Cells(1, 1) = Worksheets("Sheet2").Range("B" & currow)
'Cells(1, 2) = Worksheets("Sheet2").Range("C & currow)
' because the two cells you are copy are in adjacent cells you can copy them together which is much faster
' this code copies a RANGE for, row Currow columns b and C to A1:B1. IF your other data is in columns d onward you can copy the lot
Range(Cells(1, 1), Cells(1, 2)) = Worksheets("Sheet2").Range(Cells(currow, 2), Cells(currow, 3))




For i = 1 To 1000
Calculate
If currow > 2 Then
 currow = currow - 1
End If


'Cells(1, 1) = Worksheets("Sheet2").Range("B" & currow)
' as above
Range(Cells(1, 1), Cells(1, 2)) = Worksheets("Sheet2").Range(Cells(currow, 2), Cells(currow, 3))
' you don't need to decrement the row twice see below
'If currow > 2 Then
'currow = currow - 1
'End If
' this line of code is the wrong place becaue it is after the code that increments currow, so unless you
' really intend to pick B3 and C4 , it needs to be moved
'Cells(1, 2) = Worksheets("Sheet2").Range("c" & currow)
Range("V8:AC33").Select
Application.CutCopyMode = False
Selection.CopyRange("B8").SelectSelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If Cells(1, 1) = 1 Then k = k + 1
Next i
Cells(2, 1) = k
End Sub

 

[Mike7777]

For some reason the original one you posted won't pull the value from sheet 2 into the cell? I did't change anything. I posted as is for the one cell. It looks right best I can tell? I did a test on another cell just as a reference that worked and I can't figure out why its not pulling that info? Any thoughts?

 

[Mike7777]

So this would be what it looks like??

And Thank You very much for helping me

Sub NETWORK()
'
' NETWORK Macro
'
'
Dim k As Integer
k = 0
currow = 5000
'Cells(1, 1) = Worksheets("Sheet2").Range("B" & currow)
'Cells(1, 2) = Worksheets("Sheet2").Range("C & currow)
Range(Cells(1, 1), Cells(1, 2)) = Worksheets("Sheet2").Range(Cells(currow, 2), Cells(currow, 3))
For i = 1 To 1000
Calculate
If currow > 2 Then
 currow = currow - 1
End If
Cells(1, 1) = Worksheets("Sheet2").Range("B" & currow)
Range(Cells(1, 1), Cells(1, 2)) = Worksheets("Sheet2").Range(Cells(currow, 2), Cells(currow, 3))



Range("V8:AC33").Select
Application.CutCopyMode = False
Selection.CopyRange("B8").SelectSelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If Cells(1, 1) = 1 Then k = k + 1
Next i
Cells(2, 1) = k
End Sub

 

[offthelip]

For some reason the original one you posted won't pull the value from sheet 2 into the cell? I did't change anything. I posted as is for the one cell. It looks right best I can tell? I did a test on another cell just as a reference that worked and I can't figure out why its not pulling that info? Any thoughts?

I need more detail, what value is it not pulling from sheet 2?
The code is designed to stop at row 2!! Is that the problem? this bit of code:

If currow > 2 Then 
currow = currow - 1
End If

Says if the current row is greater than 2 decrement it , so the last row that is copied should be row 2

 

[offthelip]

One minor modification which wouldn't stop it working:

Sub NETWORK()'
' NETWORK Macro
'
'
Dim k As Integer
k = 0
currow = 5000
'Cells(1, 1) = Worksheets("Sheet2").Range("B" & currow)
'Cells(1, 2) = Worksheets("Sheet2").Range("C & currow)
Range(Cells(1, 1), Cells(1, 2)) = Worksheets("Sheet2").Range(Cells(currow, 2), Cells(currow, 3))
For i = 1 To 1000
Calculate
If currow > 2 Then
 currow = currow - 1
End If
[COLOR=#ff0000]' Cells(1, 1) = Worksheets("Sheet2").Range("B" & currow) you don't need this line the following line copies B to A1[/COLOR]


Range(Cells(1, 1), Cells(1, 2)) = Worksheets("Sheet2").Range(Cells(currow, 2), Cells(currow, 3))






Range("V8:AC33").Select
Application.CutCopyMode = False
Selection.CopyRange("B8").SelectSelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If Cells(1, 1) = 1 Then k = k + 1
Next i
Cells(2, 1) = k
End Sub

 

[Mike7777]

I got the first one to work. I had made an error. Working good now. I have to try to get the others working with it. Is what I posted above right?

 

[Mike7777]

One minor modification which wouldn't stop it working:

Sub NETWORK()'
' NETWORK Macro
'
'
Dim k As Integer
k = 0
currow = 5000
'Cells(1, 1) = Worksheets("Sheet2").Range("B" & currow)
'Cells(1, 2) = Worksheets("Sheet2").Range("C & currow)
Range(Cells(1, 1), Cells(1, 2)) = Worksheets("Sheet2").Range(Cells(currow, 2), Cells(currow, 3))
For i = 1 To 1000
Calculate
If currow > 2 Then
 currow = currow - 1
End If
[COLOR=#ff0000]' Cells(1, 1) = Worksheets("Sheet2").Range("B" & currow) you don't need this line the following line copies B to A1[/COLOR]


Range(Cells(1, 1), Cells(1, 2)) = Worksheets("Sheet2").Range(Cells(currow, 2), Cells(currow, 3))






Range("V8:AC33").Select
Application.CutCopyMode = False
Selection.CopyRange("B8").SelectSelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If Cells(1, 1) = 1 Then k = k + 1
Next i
Cells(2, 1) = k
End Sub

Thank You offthelip VERY much.
I'll give this a go here in a few. I'll let you know how it goes

 

[Mike7777]

I have another question. Sorry I should have already ask this already but I completely forgot. What if I need to get information from Sheet2 B but start from a different point for a completely different cell?
What would change? I'm guessing there would be another currow?
Thanks