Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel - compare sheet2.colums(1) to sheet7.colums(1) write to sheet6

Status
Not open for further replies.

BKearan

IS-IT--Management
Sep 27, 2007
45
US
Total Newb to VB for Applications. I've got an Excel 2007 spreadsheet that is Huge and I am manually sorting a lot of stuff. Functions have failed me. I need Code! I'm familiar with VBScript and AutoIt3.

As the subject states, I need to compare Sheet2, Column 1, Cell 1 to every cell in Sheet 7, Column 1 to see if there is a match. If there is NOT a match, I need to take the whole row (12 columns) and put it into the next available row in sheet 6.

So far, I've opened the Visual Basic editor at Sheet6 and started on Code. Its not exactly what I want... but...
Code:
' start with (A1) in (Sheet 2) and compare
' to (Sheet 7) to see if it matches any cell in (A:A)
' If there is not a match, write A1 to next row in (Sheet 6)
' Repeat for (sheets 3-5)

Sub Compare()
Dim active_sheet As Worksheet
Dim CurCell
Dim CompCell
Dim Matched As Variant
Dim RealLastRow As Long

Set active_sheet = ActiveSheet

' Loop through Sheet 2, column A - every cell that has something in it
For Each CurCell In Sheet2.Range("A:A").Cells
    If IsEmpty(CurCell) Then Exit For
    ' Compare current cell to each cell in sheet 7
    Matched = "No"
    For Each CompCell In Sheet7.Range("A:A").Cells
        If IsEmpty(CompCell) Then Exit For
        If CompCell.Value = CurCell.Value Then
            Matched = "Yes"
            Exit For
        End If
    Next
    ' Check to see if there was a match
        If Matched = "No" Then
            ' Find the Last row, move one down and put the value of matched cell into it
            RealLastRow = Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
            Cells(RealLastRow + 1, A).Value = CurCell.Value
        End If
Next

' Repeat for Sheet 3, 4 and 5

End Sub

I get a 400 error when running this... what is wrong? And Is there an easier/quicker/better way to do this?
?
 
Code no longer gives error, but doesn't do anything...
Code:
Sub Compare()
Dim active_sheet As Worksheet
Dim CurCell
Dim CompCell
Dim Matched As Variant
Dim RealLastRow As Long

Set active_sheet = ActiveSheet

' Loop through Sheet 2, column A - every cell that has something in it
For Each CurCell In Sheet2.Range("A:A").Cells
    If IsEmpty(CurCell) Then Exit For
    ' Compare current cell to each cell in sheet 7
    Matched = "No"
    For Each CompCell In Sheet7.Range("A:A").Cells
        If IsEmpty(CompCell) Then Exit For
        If CompCell.Value = CurCell.Value Then
            Matched = "Yes"
            Exit For
        End If
    Next
    ' Check to see if there was a match
        If Matched = "No" Then
            ' Find the Last row, move one down and put the value of matched cell into it
            RealLastRow = Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
            Cells(RealLastRow, "A").Value = CurCell.Value
        End If
Next

' Repeat for Sheet 3, 4 and 5

End Sub
 

Hi,

You have some unnecessary declarations...
Code:
Sub Compare()
    Dim CurCell As Range
    Dim CompCell As Range
    Dim bMatched As Boolean
    Dim RealLastRow As Long
    
    Dim ws As Worksheet
    
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Sheet2", "Sheet3", "Sheet4", "Sheet5"
               ' Loop through Sheet , column A - every cell that has something in it
               For Each CurCell In ws.Range(ws.[A1], ws.[A1].End(xlDown))
                   ' Compare current cell to each cell in sheet 7
                   bMatched = False

[b]
'is sheet CODE NAME Sheet7 also sheet NAME "Sheet7" ????[/b]
                   For Each CompCell In Sheet7.Range(Sheet7.[A1], Sheet7.[A1].End(xlDown))
                       If CompCell.Value = CurCell.Value Then
                           bMatched = True
                           Exit For
                       End If
                   Next
                   ' Check to see if there was a match
                       If Not bMatched Then
                           ' Find the Last row, move one down and put the value of matched cell into it
                           [b]
'what sheet reference here???[/b]
                           RealLastRow = Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
                           Cells(RealLastRow, "A").Value = CurCell.Value
                       End If
               Next
        End Select
    Next


End Sub

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 


This may be what you want...
Code:
Sub Compare()
    Dim CurCell As Range
    Dim CompCell As Range
    Dim bMatched As Boolean
    Dim RealLastRow As Long
    
    Dim ws As Worksheet
    
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Sheet2", "Sheet3", "Sheet4", "Sheet5"
               ' Loop through Sheet , column A - every cell that has something in it
               For Each CurCell In ws.Range(ws.[A1], ws.[A1].End(xlDown))
                   ' Compare current cell to each cell in sheet 7
                   bMatched = False

                    For Each CompCell In Sheets("Sheet7").Range(Sheets("Sheet7").[A1], Sheets("Sheet7").[A1].End(xlDown))
                        If CompCell.Value = CurCell.Value Then
                            bMatched = True
                            Exit For
                        End If
                    Next
                   ' Check to see if there was a match
                    If Not bMatched Then
                        ' Find the Last row, move one down and put the value of matched cell into it
                        
                        With Sheets("Sheet6")
                            RealLastRow = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
                            .Cells(RealLastRow + 1, "A").Value = CurCell.Value
                        End With
                    End If
               Next
        End Select
    Next
End Sub

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 


...in fact this might be faster...
Code:
Sub Compare()
    Dim CurCell As Range
    Dim CompCell As Range
    Dim rMatched As Range
    Dim RealLastRow As Long
    
    Dim ws As Worksheet
    
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Sheet2", "Sheet3", "Sheet4", "Sheet5"
               ' Loop through Sheet , column A - every cell that has something in it
               For Each CurCell In ws.Range(ws.[A1], ws.[A1].End(xlDown))
                    ' Compare current cell to each cell in sheet 7
                    
                    Set rMatched = Sheets("Sheet7").Cells.Find(CurCell.Value)
                    
                    If rMatched Is Nothing Then
                        ' Find the Last row, move one down and put the value of matched cell into it
                        
                        With Sheets("Sheet6")
                            RealLastRow = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
                            .Cells(RealLastRow + 1, "A").Value = CurCell.Value
                        End With
                    End If
               Next
        End Select
    Next


End Sub

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 


...and a bit more compact...
Code:
Sub Compare()
    Dim CurCell As Range
    Dim rMatched As Range
    Dim RealLastRow As Long
    
    Dim ws As Worksheet
    
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Sheet2", "Sheet3", "Sheet4", "Sheet5"
               ' Loop through Sheet , column A - every cell that has something in it
               For Each CurCell In ws.Range(ws.[A1], ws.[A1].End(xlDown))
                    ' find current cell value in sheet 7
                    Set rMatched = Sheets("Sheet7").Columns(1).Find(CurCell.Value)
                    
                    If rMatched Is Nothing Then
                        ' Find the Last row, move one down and put the value of matched cell into it
                        With Sheets("Sheet6")
                            RealLastRow = .[A1].CurrentRegion.Rows.Count
                            .Cells(RealLastRow + 1, "A").Value = CurCell.Value
                        End With
                    End If
               Next
        End Select
    Next
End Sub

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Thank you!

Changed up the "find last row" thing a bit and it works perfectly!
Code:
i = 2 ' because I have a column heading 
If rMatched Is Nothing Then
  ' Fill the worksheet with the results
  If CurCell.Value <> "Column Heading" Then
                      
     With Sheets("Sheet7 Label")
        If Not IsEmpty(Cells(i, "A")) Then
           i = i + 1
        End If
        Cells(i, "A") = CurCell.Value
        i = i + 1
    End With
  End If
                        
End If

... now to try to understand it myself. :D
 
To speed up processing you may also want to toss in:

Application.ScreenUpdating = False 'speeds up code...

That is especially useful with lots of data.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top