Help with VBA

Mike7777

New Member
Joined
Dec 1, 2015
Messages
19
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.
 
Last edited:
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
Code:
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
 
Last edited:
Upvote 0

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
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?

Code:
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
 
Last edited:
Upvote 0
there bits that you repeat and there are bits that you musn't repeat, I have annotated the code accordingly:
Code:
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
 
Last edited:
Upvote 0
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?
 
Upvote 0
So this would be what it looks like??

And Thank You very much for helping me

Code:
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
 
Last edited:
Upvote 0
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:
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
 
Upvote 0
One minor modification which wouldn't stop it working:
Code:
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
 
Upvote 0
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?
 
Upvote 0
One minor modification which wouldn't stop it working:
Code:
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

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
Back
Top