How do I loop through two columns and select rows and add to that selection of rows? - vba

Question

I'm fairly new to VBA. I'm currently trying to find a faster way to copy and paste information by using Macros. I'm not sure how to code this.
I have two columns I want to use with a For Each loop.
I wanted to loop through each row of these two columns and use an If function. If the first row has a value in Column B (Column B cell <> "" Or Column B cell <> 0) then, select that row (i.e. Range("A1:B1")).
After the loop, I will copy whatever is selected and paste it to a specific row.
However, I want to keep adding to that selection as it loops through each row and only if it satisfies the If condition, so I'm able to copy it all once at the end. How do I go about combining this?
A B
1 Abc 1
2 Def 2
3 Geh 3

Answer 1

This is how you can expand current selection:
Sub macro1()
Set selectedCells = Cells(1, 2)
Set selectedCells = Application.Union(selectedCells, Cells(2, 3))
selectedCells.Select
End Sub
I'm sure you can manage the rest of your code by yourself, it's really easy. You already mentioned everything you need: For Each cell In Range("B1:B5") and If statement

Answer 2

Please try the below code
Sub test()
Application.ScreenUpdating = False
Dim rng As Range, one As Variant
Dim i As Integer
'Change the sheet and range name as yours
'Finding lastrow of destination column
i = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1
' getting input from user
Set rng = Application.InputBox("Please select a range of cells!", "Please select a range", Selection.Address, , , , , 8)
For Each one In rng
If one.Value <> "" Or one.Value <> 0 Then
Range(one.Offset(0, -1), one).Copy
'Change the sheet and range name as yours
Sheets("Sheet2").Activate
Range("A" & i).Select
ActiveSheet.Paste
i = i + 1
End If
Next one
Application.ScreenUpdating = True
End Sub
The above macro will prompt you for the input range to be validate and copy to sheet2 in column A.
The below code will validate and copy paste the current selected range to sheet2 column A
Sub test()
Application.ScreenUpdating = False
Dim rng As Range, one As Variant
Dim i As Integer
'Chnage the sheet and range name as yours
'Finding lastrow of destination column
i = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1
' getting input from user
Set rng = Selection
For Each one In rng
If one.Value <> "" Or one.Value <> 0 Then
Range(one.Offset(0, -1), one).Copy
'Chnage the sheet and range name as yours
Sheets("Sheet2").Activate
Range("A" & i).Select
ActiveSheet.Paste
i = i + 1
End If
Next one
Application.ScreenUpdating = True
End Sub

Answer 3

I think you're probably going about this the wrong way. Do you already know to where you would like to copy all the data in the end? It sounds like it, as you refer to copying it "to a specific row". If so, you'd be better off using your macro to copy the data from Columns A:B on the fly.
So, for example:
Sub CopyData()
Const SOURCE_COLUMN1 As Long = 1 ' A
Const SOURCE_COLUMN2 As Long = 2 ' B
Const TARGET_COLUMN1 As Long = 5 ' E
Const TARGET_COLUMN2 As Long = 6 ' F
Dim lngSourceRow As Long
Dim lngTargetRow As Long
With ThisWorkbook.Sheets("Sheet1")
lngSourceRow = 1
lngTargetRow = 0 ' Change this to the row above the one you want to copy to;
Do While .Cells(lngSourceRow, SOURCE_COLUMN1) <> ""
If .Cells(lngSourceRow, SOURCE_COLUMN2) <> "" Then
lngTargetRow = lngTargetRow + 1
.Cells(lngTargetRow, TARGET_COLUMN1) = .Cells(lngSourceRow, SOURCE_COLUMN1)
.Cells(lngTargetRow, TARGET_COLUMN2) = .Cells(lngSourceRow, SOURCE_COLUMN2)
End If
lngSourceRow = lngSourceRow + 1
Loop
End With
End Sub