I have some code that loops through a row and a column and compares data. When it finds the values being equal it copies the columns the row is in and pastes it on another sheet along with the previous value of the column.

For Each CCell In Range("C2:C65418")
If Not IsEmpty(CCell.Value) Then
Dim room As String
CCell.Offset(0, -1).Select
room = Selection.Value
Sheets("FFE_Item_Matrix").Select
For Each GCell In Range("G2:ZZ2")
If Not IsEmpty(GCell.Value) Then
If CCell <> GCell Then
'THIS IS NOT WORKING:
Sheets("Rooms").Select
Range("G2").Activate
Range("G2").Select
Selection.Value = GCell.EntireColumn
End If
Else
Exit For
End If
Next GCell
Else
Exit For
End If
Next CCell

I'm having trouble copying the column the row is in. Can someone help me? Its not working.

It would be easiest to assist if I could see a before/after sort of sample sheet. It would make fixing your macro simpler, or possibly point to a solution that doesn't include individually looping through 65000 cells. (ugh).

If you click on GO ADVANCED you can use the paperclip icon to post up a sample worksheet. It would be great to see a "desired results" page so the goal is clear.

Just staring at it with no sheet to test on or understanding of even where you were when you activated this macro, this seems to me be what you're aiming for, or at least closer to it:


For Each CCell In Range("C2:C65418")
If Not IsEmpty(CCell.Value) Then
room = CCell.Offset(0, -1).Value
Sheets("FFE_Item_Matrix").Activate

For Each GCell In Range("G2:ZZ2")
If Not IsEmpty(GCell.Value) Then
If CCell <> GCell Then
GCell.EntireColumn.Copy
Sheets("Rooms").Range("G:G").PasteSpecial Paste:=xlPasteAll, _
Operation:=xlAdd, SkipBlanks:=False, Transpose:=False
End If
Else
Exit For
End If
Next GCell
Else
Exit For
End If
Next CCell

Well it doesn't loop through all the cells individually. It stops as soon as it finds a blank one.

There's the sample... So on sheet2 it goes down the B row and compares those values to the 2nd column on sheet1.

It stores the values on sheet 2, column 1 for when it finds a match. (in the outer loop that's what the room variable is for)

So then when it finds a match it should copy the sheet1 column where it found the match and paste to a new sheet.



For Each CCell In Range("C2:C65418")
If Not IsEmpty(CCell.Value) Then
Dim room As String
CCell.Offset(0, -1).Select
room = Selection.Value
Sheets("FFE_Item_Matrix").Select
'WORKS FINE TO HERE
For Each GCell In Range("G2:ZZ2")
If Not IsEmpty(GCell.Value) Then
If CCell <> GCell Then
Sheets("Rooms").Select
Range("G2").Activate
Range("G2").Select
Selection.Value = GCell.EntireColumn
End If
Else
Exit For
End If
Next GCell
Else
Exit For
End If
Next CCell

if you have a better solution please let me know!

Also for this new sheet if you know how to make it so that each time it pastes a column it moves over one that would be great. At the moment for testing I had it just post in the G column but I need it to do that for the first, H for the second, etc, etc until all the rows in Sheet2 have gone through.

Again, no sheet means helping blind. I've demonstrated how to ADD a column to an existing column, all the cells add together:

GCell.EntireColumn.Copy
Sheets("Rooms").Range("G:G").PasteSpecial Paste:=xlPasteAll, _
Operation:=xlAdd, SkipBlanks:=False, Transpose:=False

If what you want now is to paste the column into the first empty column, then something like this:

GCell.EntireColumn.Copy Sheets("Rooms").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)

There's the sample... So on sheet2 it goes down the B row and compares those values to the 2nd column on sheet1.

It stores the values on sheet 2, column 1 for when it finds a match. (in the outer loop that's what the room variable is for)

So then when it finds a match it should copy the sheet1 column where it found the match and paste to a new sheet (sheet 3). The column on sheet3 should shift one each time a column is copied.

So then when it finds a match it should copy the sheet1 column where it found the match and paste to a new sheet (sheet 3). The column on sheet3 should shift one each time a column is copied.
Since the dataset is so small and the explanation not 100% clear in my head, how about posting this sample workbook with the desired/expected results, too? Let me see exactly what you want created.

Here.. Result shows what I want
BEFORE sheet is what it looks like first. It has room types and what's in the room. It compares it to the COMPARE sheet which has room numbers and types. The result shows the room number type and what's in the room.

So it compares the types, then when it finds a match copies the column to the RESULT sheet so you can see the room number, type and what's in it.

I want to know how to make it move over one column each time it pastes the column in. Also is it possible to sort a row (should go in order of ascending room)?

Here is the whole code:



Sub ByRoom()
'
' ByRoom Macro
'

'
On Error GoTo ErrorHandler

If MsgBox("Make sure you have already formatted the Matrix." & vbCrLf & "Are you sorting by room?", vbQuestion + vbYesNo, "Matrix Tool?") = vbYes Then
Sheets.Add.Name = "Rooms"
Sheets("FFE_Item_Matrix").Select
Columns("A:F").Select
Range("F1").Activate
Selection.Copy
Sheets("Rooms").Select
Range("A1").Select
ActiveSheet.Paste

Worksheets("Sheet1").Select
Columns("C:C").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A2:C65418")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For Each CCell In Range("C2:C65418")
If Not IsEmpty(CCell.Value) Then
Dim room As String
CCell.Offset(0, -1).Select
room = Selection.Value
Sheets("FFE_Item_Matrix").Select
For Each GCell In Range("G2:ZZ2")
If Not IsEmpty(GCell.Value) Then
If CCell <> GCell Then
GCell.EntireColumn.Copy
Sheets("Rooms").Range("G:G").PasteSpecial Paste:=xlPasteAll, _
Transpose:=False

End If
Else
Exit For
End If
Next GCell
Else
Exit For
End If
Next CCell


Else
Exit Sub
End If
Exit Sub
ErrorHandler:
Resume Next
End Sub


When I do this its still copying the first part over (Columns A-F done outside the loop)

After looking at the macro and the suggested line of code I already gave you in post #6, that is still the right answer as far as I can see.

GCell.EntireColumn.Copy Sheets("Rooms").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
Put that in place in these lines:

For Each GCell In Range("G2:ZZ2")
If Not IsEmpty(GCell.Value) Then
If CCell <> GCell Then
GCell.EntireColumn.Copy Sheets("Rooms").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
End If

SHort of designing an entirely new macro matrix, I know of no way to sort across a row.

This copies the first part (the A:F) and pastes it in the empty cells. It only does it once then continually pastes over it.





Sub ByRoom()
'
' ByRoom Macro
'

'
On Error GoTo ErrorHandler

If MsgBox("Make sure you have already formatted the Matrix." & vbCrLf & "Are you sorting by room?", vbQuestion + vbYesNo, "Matrix Tool?") = vbYes Then
Sheets.Add.Name = "Rooms"
Sheets("FFE_Item_Matrix").Select
Columns("A:F").Select
Selection.Copy
Sheets("Rooms").Select
Range("A1").Select
ActiveSheet.Paste
Range("G1").Activate
Sheets("FFE_Item_Matrix").Select
Range("G1").Activate

Worksheets("Sheet1").Select
Columns("C:C").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A2:C65418")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For Each CCell In Range("C2:C65418")
If Not IsEmpty(CCell.Value) Then
Dim room As String
CCell.Offset(0, -1).Select
room = Selection.Value
Sheets("FFE_Item_Matrix").Select
For Each GCell In Range("G2:ZZ2")
If Not IsEmpty(GCell.Value) Then
If CCell <> GCell Then
GCell.Activate
GCell.EntireColumn.Copy Sheets("Rooms").Select.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
ActiveSheet.Paste
End If
Else
Exit For
End If
Next GCell
Else
Exit For
End If
Next CCell


Else
Exit Sub
End If
Exit Sub
ErrorHandler:
Resume Next
End Sub





Thanks for your help so far.. sorry to be such a bother!

I think that "activesheet.paste" after the line of code I gave you is unnecessarily copying a second time, try removing that and see if you get better results.

Thank you. You have been a HUGE help.