Ask Experts Questions for FREE Help !
Ask
    adalton's Avatar
    adalton Posts: 22, Reputation: 1
    New Member
     
    #1

    May 15, 2009, 08:09 AM
    Excel Macro
    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.
    JBeaucaire's Avatar
    JBeaucaire Posts: 5,426, Reputation: 997
    Software Expert
     
    #2

    May 15, 2009, 01:53 PM

    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.
    JBeaucaire's Avatar
    JBeaucaire Posts: 5,426, Reputation: 997
    Software Expert
     
    #3

    May 15, 2009, 02:05 PM
    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:

    Code:
        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
    adalton's Avatar
    adalton Posts: 22, Reputation: 1
    New Member
     
    #4

    May 15, 2009, 02:21 PM
    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.

    Code:
    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!
    adalton's Avatar
    adalton Posts: 22, Reputation: 1
    New Member
     
    #5

    May 15, 2009, 02:23 PM
    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.
    JBeaucaire's Avatar
    JBeaucaire Posts: 5,426, Reputation: 997
    Software Expert
     
    #6

    May 15, 2009, 02:30 PM

    Again, no sheet means helping blind. I've demonstrated how to ADD a column to an existing column, all the cells add together:
    Code:
    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:
    Code:
    GCell.EntireColumn.Copy Sheets("Rooms").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
    adalton's Avatar
    adalton Posts: 22, Reputation: 1
    New Member
     
    #7

    May 18, 2009, 03:13 PM
    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.
    Attached Files
  1. File Type: xls sample.xls (13.5 KB, 203 views)
  2. JBeaucaire's Avatar
    JBeaucaire Posts: 5,426, Reputation: 997
    Software Expert
     
    #8

    May 19, 2009, 12:23 AM
    Quote Originally Posted by adalton View Post
    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.
    adalton's Avatar
    adalton Posts: 22, Reputation: 1
    New Member
     
    #9

    May 19, 2009, 10:27 AM
    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)?
    Attached Files
  3. File Type: xls MacroSample.xls (27.5 KB, 173 views)
  4. adalton's Avatar
    adalton Posts: 22, Reputation: 1
    New Member
     
    #10

    May 19, 2009, 11:02 AM
    Here is the whole code:
    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)
    JBeaucaire's Avatar
    JBeaucaire Posts: 5,426, Reputation: 997
    Software Expert
     
    #11

    May 19, 2009, 09:45 PM

    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.
    Code:
    GCell.EntireColumn.Copy Sheets("Rooms").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
    Put that in place in these lines:
    Code:
            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.
    adalton's Avatar
    adalton Posts: 22, Reputation: 1
    New Member
     
    #12

    May 20, 2009, 07:13 PM

    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.

    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
        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!
    JBeaucaire's Avatar
    JBeaucaire Posts: 5,426, Reputation: 997
    Software Expert
     
    #13

    May 26, 2009, 01:58 AM

    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.
    adalton's Avatar
    adalton Posts: 22, Reputation: 1
    New Member
     
    #14

    May 26, 2009, 05:39 PM

    Thank you. You have been a HUGE help.

Not your question? Ask your question View similar questions

 

Question Tools Search this Question
Search this Question:

Advanced Search

Add your answer here.


Check out some similar questions!

Auto-Macro in Excel [ 4 Answers ]

Hi, I have a lot of macros built-in Excel, but when I want to update the certain data , I have to run them individually each time. Do you know anyway I can auto-run these macros? Thanks for any help.

Excel macro [ 4 Answers ]

I need to run a macro that opens excel so I can kick off "application.ontime" basically my macro should run without me having to start excel, just have the computer and outlook running. Is that possible?

How to Automate a macro in excel [ 4 Answers ]

A program logs files at random in txt. abc_log.txt (example) When new info. Is added to the txt file,manualy activate macro and it does what it suppose to do, all OK there. Is there a way a macro code or excel, or perhaps a BAT program can be made to simply "detect" when new data is added...


View more questions Search