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!

Register Log in
  • Congratulations strongm 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

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?
?
 
Sort by date Sort by votes
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
 
Upvote 0 Downvote

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]
 
Upvote 0 Downvote


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]
 
Upvote 0 Downvote


...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]
 
Upvote 0 Downvote


...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]
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
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.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Solved
Run-time error '429': ActiveX component can't create object From Excel to Word
Replies
9
Views
556
remeng
remeng
rf92d
  • Locked
  • Question
Hi referring to thread707-107529
Replies
0
Views
202
rf92d
rf92d
rf92d
  • Locked
  • Question
hi referring to thread707-103495
Replies
9
Views
290
Andrzejek
Andrzejek
K
  • Locked
  • Question
How to resolve define worksheets array
Replies
1
Views
310
combo
combo
Kymenglish
  • Locked
  • Question
Automated data entry code in MS Excel VB - Edge code how to hit enter to remove popups
Replies
3
Views
198
strongm
strongm

Part and Inventory Search

Sponsor

Back
Top