cwb1021
03-11-2017, 11:07 AM
Hello Experts,
This is my first attempt with VBA and I need a little help with the loop syntax.
I'm attempting to write a sub procedure that will loop through a range of cells in a column on the active worksheet, copy a value from that row, and paste it on to another worksheet in the same workbook.
So basically, if a value is identified as less than or equal to the variable ScanRadius in column 7 of worksheet Sample, I would like for the sub procedure to copy a value from the cell A1 in that same row, and paste it to another worksheet (OffsetList).
I've tried multiple variations of this and each time the procedure stalls at the "copy" command.
Sub TestLoopAgain()
Dim cell As Range, OffsetRange As Range
Dim ScanRadius As Single
Dim wsSample As Worksheet: Set wsSample = Worksheets("Sample")
Dim wsOffsetList As Worksheet: Set wsOffsetList = Worksheets("OffsetList")
'Selects Offset Distance column in sample data for comparison against input scan radius
Application.Workbooks("MacroTest.xlsm").Worksheets("Sample").Activate
ActiveSheet.Columns(7).Select
'Limits data scanned to last row of used section - eliminates scanning of blank cells
Set OffsetRange = Intersect(Selection, ActiveSheet.UsedRange)
'Sets variable ScanRadius to value input on worksheet
ScanRadius = Application.Workbooks("MacroTest.xlsm").Worksheets("ScanRadius").Range("c3")
'Compares each offset distance to scan radius and returns values within radius
For Each cell In Selection
If cell.Value <= ScanRadius Then
wsSample.Range("A2").Copy '<===============Stuck here - debugger will not go past this line
wsOffsetList.Activate '<=============Im not sure about the code after this. I have not been able to test it since the procedure stalls at copy.
wsOffsetList.Range("A" & swOffsetList.Range("A" & Rows.Count).End(xlUp).Row + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
End If
Next cell
End Sub
Any help would be greatly appreciated. Please let me know if I am leaving out any necessary information.
Thanks,
Chris
This is my first attempt with VBA and I need a little help with the loop syntax.
I'm attempting to write a sub procedure that will loop through a range of cells in a column on the active worksheet, copy a value from that row, and paste it on to another worksheet in the same workbook.
So basically, if a value is identified as less than or equal to the variable ScanRadius in column 7 of worksheet Sample, I would like for the sub procedure to copy a value from the cell A1 in that same row, and paste it to another worksheet (OffsetList).
I've tried multiple variations of this and each time the procedure stalls at the "copy" command.
Sub TestLoopAgain()
Dim cell As Range, OffsetRange As Range
Dim ScanRadius As Single
Dim wsSample As Worksheet: Set wsSample = Worksheets("Sample")
Dim wsOffsetList As Worksheet: Set wsOffsetList = Worksheets("OffsetList")
'Selects Offset Distance column in sample data for comparison against input scan radius
Application.Workbooks("MacroTest.xlsm").Worksheets("Sample").Activate
ActiveSheet.Columns(7).Select
'Limits data scanned to last row of used section - eliminates scanning of blank cells
Set OffsetRange = Intersect(Selection, ActiveSheet.UsedRange)
'Sets variable ScanRadius to value input on worksheet
ScanRadius = Application.Workbooks("MacroTest.xlsm").Worksheets("ScanRadius").Range("c3")
'Compares each offset distance to scan radius and returns values within radius
For Each cell In Selection
If cell.Value <= ScanRadius Then
wsSample.Range("A2").Copy '<===============Stuck here - debugger will not go past this line
wsOffsetList.Activate '<=============Im not sure about the code after this. I have not been able to test it since the procedure stalls at copy.
wsOffsetList.Range("A" & swOffsetList.Range("A" & Rows.Count).End(xlUp).Row + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
End If
Next cell
End Sub
Any help would be greatly appreciated. Please let me know if I am leaving out any necessary information.
Thanks,
Chris