PDA

View Full Version : [SOLVED] Copy values from loop and paste in different worksheet



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

mdmackillop
03-11-2017, 02:23 PM
For Each cell In Selection - this will cycle through each cell in column 7
wsSample.Range("A2").Copy - This will copy the same cell every time
I'm guessing here with a simplified code

Option Explicit
Sub TestLoopAgain()
Dim cell As Range, OffsetRange As Range
Dim ScanRadius As Single
Dim wsS As Worksheet
Dim wsO As Worksheet

Set wsS = Worksheets("Sample")
Set wsO = Worksheets("OffsetList")
Set OffsetRange = Intersect(wsS.Columns(7), wsS.UsedRange)
ScanRadius = Worksheets("ScanRadius").Range("c3")
For Each cell In OffsetRange
If cell.Value <= ScanRadius Then
cell.Offset(, -6).Copy
wsO.Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
End If
Next cell
End Sub

cwb1021
03-12-2017, 07:38 AM
mdmackillop,

Thanks so much for your reply. I'll try it out and post the results.

Thanks,

Chris

cwb1021
03-12-2017, 08:08 AM
mdmackillop,

This worked perfectly. I appreciate the help.

Thanks,

Chris