copy and paste resultant column into another spreadsheet - excel

Question

I was wondering if it is possible for someone to help me shorten the code as i'm afraid it might take a long time to run after i add in other codes. What i want to do will be explain in the following:
I want to copy say test2 (do take note that the spacing means the variables are on their own row and column)
test1 1 2 1
test2 2 1 4
test3 1 1 1
After copying it I will paste it at some other sheet.
Let say, I have another set of results
Say
test2 2 1 4
test3 3 9 8
test5 1 1 1
I wanted to copy test2 but my VBA coding werent able to as it still assumes that test2 is at 2nd row.
And one last case would be, if test2 not available, it will continue on copying the rest of the result and paste it at other sheets.
I have did some coding, do run through and help me solve this problem. THANKS!
Sub Macro1()
iMaxRow = 6 ' or whatever the max is.
'Don't make too large because this will slow down your code.
' Loop through columns and rows
For iCol = 1 To 1 ' or however many columns you have
For iRow = 1 To 1
With Worksheets("Sheet3").Cells(iRow, iCol)
' Check that cell is not empty.
If .Value = "Bin1" Then
Range("A1:G1").Select
Selection.Copy
Sheets("sheet4").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("sheet3").Select
ElseIf .Value = "Bin2" Then
Range("A1:G1").Select
Selection.Copy
Sheets("sheet4").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("sheet3").Select
ElseIf .Value = "Bin3" Then
Range("A1:G1").Select
Selection.Copy
Sheets("sheet4").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("sheet3").Select
ElseIf .Value = "Bin4" Then
Range("A1:G1").Select
Selection.Copy
Sheets("sheet4").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("sheet3").Select
ElseIf .Value = "Bin5" Then
Range("A1:G1").Select
Selection.Copy
Sheets("sheet4").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("sheet3").Select
ElseIf .Value = "Bin6" Then
Range("A1:G1").Select
Selection.Copy
Sheets("sheet4").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("sheet3").Select
End If
End With
Next iRow
Next iCol
For iCol1 = 1 To 1 ' or however many columns you have
For iRow1 = 1 To 2
With Worksheets("Sheet3").Cells(iRow1, iCol1)
' Check that cell is not empty.
If .Value = "Bin2" Then
Range("A2:G2").Select
Selection.Copy
Sheets("sheet4").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("sheet3").Select
ElseIf .Value = "Bin3" Then
Range("A2:G2").Select
Selection.Copy
Sheets("sheet4").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("sheet3").Select
ElseIf .Value = "Bin4" Then
Range("A2:G2").Select
Selection.Copy
Sheets("sheet4").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("sheet3").Select
ElseIf .Value = "Bin5" Then
Range("A2:G2").Select
Selection.Copy
Sheets("sheet4").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("sheet3").Select
ElseIf .Value = "Bin6" Then
Range("A2:G2").Select
Selection.Copy
Sheets("sheet4").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("sheet3").Select
End If
End With
Next iRow1
Next iCol1
For iCol2 = 1 To 1 ' or however many columns you have
For iRow2 = 1 To 3
With Worksheets("Sheet3").Cells(iRow2, iCol2)
' Check that cell is not empty.
If .Value = "Bin3" Then
Range("A3:G3").Select
Selection.Copy
Sheets("sheet4").Select
Range("A3").Select
ActiveSheet.Paste
Sheets("sheet3").Select
ElseIf .Value = "Bin4" Then
Range("A3:G3").Select
Selection.Copy
Sheets("sheet4").Select
Range("A3").Select
ActiveSheet.Paste
Sheets("sheet3").Select
ElseIf .Value = "Bin5" Then
Range("A3:G3").Select
Selection.Copy
Sheets("sheet4").Select
Range("A3").Select
ActiveSheet.Paste
Sheets("sheet3").Select
ElseIf .Value = "Bin6" Then
Range("A3:G3").Select
Selection.Copy
Sheets("sheet4").Select
Range("A3").Select
ActiveSheet.Paste
Sheets("sheet3").Select
End If
End With
Next iRow2
Next iCol2
For iCol3 = 1 To 1 ' or however many columns you have
For iRow3 = 1 To 4
With Worksheets("Sheet3").Cells(iRow3, iCol3)
' Check that cell is not empty.
If .Value = "Bin4" Then
Range("A4:G4").Select
Selection.Copy
Sheets("sheet4").Select
Range("A4").Select
ActiveSheet.Paste
Sheets("sheet3").Select
ElseIf .Value = "Bin5" Then
Range("A4:G4").Select
Selection.Copy
Sheets("sheet4").Select
Range("A4").Select
ActiveSheet.Paste
Sheets("sheet3").Select
ElseIf .Value = "Bin6" Then
Range("A4:G4").Select
Selection.Copy
Sheets("sheet4").Select
Range("A4").Select
ActiveSheet.Paste
Sheets("sheet3").Select
End If
End With
Next iRow3
Next iCol3
For iCol4 = 1 To 1 ' or however many columns you have
For iRow4 = 1 To 5
With Worksheets("Sheet3").Cells(iRow4, iCol4)
' Check that cell is not empty.
If .Value = "Bin5" Then
Range("A5:G5").Select
Selection.Copy
Sheets("sheet4").Select
Range("A5").Select
ActiveSheet.Paste
Sheets("sheet3").Select
ElseIf .Value = "Bin6" Then
Range("A5:G5").Select
Selection.Copy
Sheets("sheet4").Select
Range("A5").Select
ActiveSheet.Paste
Sheets("sheet3").Select
End If
End With
Next iRow4
Next iCol4
For iCol5 = 1 To 1 ' or however many columns you have
For iRow5 = 1 To 6
With Worksheets("Sheet3").Cells(iRow5, iCol5)
' Check that cell is not empty.
If .Value = "Bin6" Then
Range("A6:G6").Select
Selection.Copy
Sheets("sheet4").Select
Range("A6").Select
ActiveSheet.Paste
Sheets("sheet3").Select
End If
End With
Next iRow5
Next iCol5
Sheets("Sheet4").Select
Range("A1").Select
End Sub

Answer 1

I am struggling to identify what your code does. Below I specify some simplifications and other necessary improvements but there may be more once we have cleared the brushwood.
Change 1
Please use Option Explicit and please declare your variables. This avoids a misspelt variable being taken as a new implicit declaration.
Change 2
Please use Application.ScreenUpdating = False. This avoids repainting the screen as the macro works through its tasks. This would have been essential with your code because of all the switching between sheets. It is less important with my code because I do not switch sheets.
Change 3
Replace:
With Sheets("Sheet3")
:
Range("A1:G1").Select
Selection.Copy
Sheets("sheet4").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("sheet3").Select
:
End With
by:
With Sheets("Sheet3")
:
.Range("A1:G1").Copy Destination:=Worksheets("Sheet4").Range("A1")
:
End With
This avoids switching sheets which is the biggest waste of time.
Change 4
For each If-ElseIf-ElseIf-EndIf you do the same copy. So:
If .Value = "Bin1" Or .Value = "Bin2" Or .Value = "Bin3" _
.Value = "Bin4" Or .Value = "Bin5" Then
would have the same effect.
Summary so far
I believe the following does exactly the same as your first loop:
Option Explicit
Sub Macro1()
Dim iCol As Long
Dim iRow As Long
Dim ValueCell as String
With Sheets("Sheet3")
For iCol = 1 To 1
For iRow = 1 To 1
ValueCell = .Cells(iRow, iCol).Value
If ValueCell = "Bin1" Or ValueCell = "Bin2" Or ValueCell = "Bin3" Or _
ValueCell = "Bin4" Or ValueCell = "Bin5" Then
.Range("A1:G1").Copy Destination:=Worksheets("Sheet4").Range("A1")
End If
Next
Next
End With
End Sub
Possible further change
Are the loops really independent? To me it looks as though you could merge them into a single loop.
New section added in response to exchange of comments
Consider the code in your question:
You have six double loops.
In every case, the outer loop is For iCol = 1 to 1. That is, you only examine column "A" although you imply you would examine more columns if the code was faster.
The inner loop is For iRow = 1 to №. № is 1 in the first loop, 2 in the second and 6 in the sixth loop. Again you imply you would examine more rows if the code was faster.
The action for each loop depends on the value of №.
Table showing effect of № of action:
Value
of № Cells examined Values checked for Range moved
1 A1 "Bin1" ... "Bin6" A1:G1
2 A1, A2 "Bin2" ... "Bin6" A2:G2
3 A1, A2, A3 "Bin3" ... "Bin6" A3:G3
4 A1, A2, ... A4 "Bin4" ... "Bin6" A4:G4
5 A1, A2, ... A5 "Bin5", "Bin6" A5:G5
6 A1, A2, ... A6 "Bin6" A6:G6
That is, in double loop №, you examine cells A1 to A№, check for values "Bin№" to "Bin6" and if found, you copy Sheets("Sheet3").Range("A№:G№") to Sheets("Sheet4").Range("A№).
In your text and example data, you refer to "text2" instead of "Bin2". I do not understand what you are trying to do. Below, I introduce some more VBA which may help you create the code you want. If it does not, you will have to add a new section to your question explaining in English what you are trying to do.
New syntax 1
Consider:
For iRow = 1 to 6
:
.Range("A6:G6").Copy Destination:=Worksheets("Sheet4").Range("A6")
:
Next
"A6:G6" and "A6" are strings that you can build at runtime.
Now consider:
For iRow = 1 to iRowMax
:
.Range("A" & iRowMax & ":G" & iRowMax)).Copy _
Destination:=Worksheets("Sheet4").Range("A" & iRowMax)
:
Next
According to the value of iRowMax this gives:
iRow Statement
1 .Range("A1:G1")).Copy Destination:=Worksheets("Sheet4").Range("A1")
2 .Range("A2:G2")).Copy Destination:=Worksheets("Sheet4").Range("A2")
3 .Range("A3:G3")).Copy Destination:=Worksheets("Sheet4").Range("A3")
New syntax 2
Another way of changing a range at runtime is to replace:
.Range(string)
with
.Range(.Cells(RowTop,ColLeft),.Cells(RowBottom,ColRight))
With this syntax you can easily specify a rectangle of the size required.
New syntax 3
Consider:
For i = 1 to 5
If this(i) = that Then
Do something fixed
Exit For
End If
Next
' Exit For statement jumps to here
In this loop, I am testing five values. If any match, I do something. If I get a match on the first value, I do not need to check the other values. Exit For allows me to jump out of the For-Loop. If there are nested For-Loops, Exit For only exits the inner loop
New syntax 4
"Bin1", "Bin2" and so on can also be created at runtime.
iRowMax = 4
For iRow = 1 to iRowMax
For iBin = iRowMax to 6
If ValueCell = "Bin" & iBin Then
' Move Range
Exit For
End If
Next
' Exit For statement jumps to here
Next
With iRow = 4, the inner For-Loop sets iBin to 4, 5 and 6. This sets "Bin" & iBin to "Bin4", "Bin5" and "Bin6".
So:
For BinNum = iRowMax to 6
If ValueCell = "Bin" & BinNum Then
' Move Range
Exit For
End If
Next
is the same as:
If ValueCell = "Bin4" Or ValueCell = "Bin5" Or ValueCell = "Bin6" Then
' Move Range
End If
This new code is more complicated and is more difficult to understand than the original, but it may be what you need.
Summary
I have shown you different ways of changing what happens depending on the value of iRow. I hope one of them will allow you to build the routine you want.
I have not tested it but I think this does the same as all six loops in your original code:
Option Explicit
Sub Macro1()
Dim iBin as Long
Dim iCol As Long
Dim iRow As Long
Dim iRowMax as Long
Dim ValueCell as String
Application.ScreenUpdating = False
With Sheets("Sheet3")
For iRowMax = 1 to 6
For iCol = 1 To 1 ' This could be replaced by iCol = 1 at the top
For iRow = 1 To iRowMax
ValueCell = .Cells(iRow, iCol).Value
For iBin = iRowMax to 6
If ValueCell = "Bin" & iBin Then
.Range("A" & iRowMax & ":G" & iRowMax)).Copy _
Destination:=Worksheets("Sheet4").Range("A" & iRowMax)
End If
Next iBin
Next iRow
Next iCol
End With
End Sub
Note: only removing all the Select statements makes this code faster than yours. The other changes make it smaller and very slightly slower because I have two extra For-Loops and I am building strings at runtime.