Solved: FindNext structure issues

[lanhao]

Well, just when i thought i had everything covered on this thing...

I am running into a problem with one part of the code specifically not working. I need to have it check to see if a value is on a target spreadsheet, if it finds that value, it has to check to see if two other cells on the same row are also the same (basically I'm checking three values on one row and seeing if they match between two sheets). If they don't, it will copy the row over.

The problem that I am running into on this is that if it finds the first value, and doesn't match up to the other values on that row, it will just copy it. I need it to go to the next instance of that value showing up adn compare to that one as well (basically having issues with the findnext layout in this code).

I apologize for being a contstant pain on this, and I do want to thank you for all the help and suggestions that have been given up to this point, and also any help in the present as well.

[vba]Sub Datamove()
'
' Datamove Macro
' Macro recorded 10/13/2006 by Andy Lewis
'
'Baseline variable list
Set sht1 = Worksheets("Uncorrected QC")
'Counters for respective worksheet pages
Dim i As Integer
Dim k As Integer 'Row counter for sht1
Dim v As Integer
Dim tick As Long 'Counter for records copied
Dim eRow As Long 'Last row on sht2
Dim sht2 As Worksheet 'worksheet that will change name depending on a value
Dim Tac As String, Trep As String, Tindt As String 'values based on the find function
Application.ScreenUpdating = False
k = 2
v = 2
tick = 0
With sht1
For v = 2 To sht1.Cells(Rows.Count, "A").End(xlUp).Row 'Goes through each row on sht1
Dim shName As String
shName = sht1.Cells(k, "H")
Set sht2 = Sheets(shName)
eRow = sht2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Dim c As Range
Set c = sht2.Columns(2).Find(sht1.Cells(k, "B").Value)

'If it finds no match, it copies the row from sht1 to the respective sheet
If c Is Nothing Then
Set c = Nothing
sht1.Rows(k).Copy Destination:=sht2.Rows(eRow)
tick = tick + 1

'If it does find a match value wise, it compares those two cells as well
'to see if they match
Else
'MsgBox "Already Exists"
FirstAddr = c.Address
Do
Set c = sht2.Columns(2).FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddr
Tac = c.Address
Trep = c.Offset(0, 2).Value
Tindt = c.Offset(0, 3).Value
If Trep <> sht1.Cells(k, "D").Value And Tindt <> sht1.Cells(k, "E").Value Then
sht1.Rows(k).Copy Destination:=sht2.Rows(eRow)
tick = tick + 1
'If it finds that either of the two variables don't match -
'it will copy the row over
End If
'Does nothing else
End If
k = k + 1
Next v
MsgBox "Records copied: " & tick
End With
Application.ScreenUpdating = True
End Sub
[/vba]

Edited 31-Oct-06 by geekgirlau. Reason: insert line breaks

[mdmackillop]

I'm stuck without Excel here, so a bit limited.
Are you comparing Text or Values. Trep and Tint are declared as strings .Text may give a better solution.
You may wish to use Option Compare Text to avoid any capital letter issues if you're dealing with text.

[lanhao]

well, one cell range is text, the other cell range is a date value. Your initial code for doing the find was great, and has helped me get to where it's at right now. the only downside is that is the problem where i am at right now, since it is only looking at what that first c value is.

Not familiar with the compare option, but the text is names of representatives.

[johnske]

well, one cell range is text, the other cell range is a date value...

If you're using Find to look for dates you'll need to specify the LookIn:=xlFormulas argument...

[SamT]

Ianhao,
I did some straight string substitutions to make it a little more self documenting.

[vba]
Sub Datamove()
'
' Datamove Macro
' Macro recorded 10/13/2006 by Andy Lewis
'
'Baseline variable list
Set UnCorrectedSheet = Worksheets("Uncorrected QC")

Dim ColA As Long
Dim ColB As Long
Dim ColD As Long

DimUnCorrectedNameRow As Long

'Counters for respective worksheet pages
Dim i As Long
Dim UnCorrectedRowCounter As Long 'Row counter for UnCorrectedSheet
Dim MainLoopCounter As Long
Dim tick As Long 'Counter for records copied
Dim GoodSheetLastRow As Long 'Last row on GoodSheet
Dim GoodSheet As Worksheet 'worksheet that will change name depending on a value
'values based on the find function
Dim Tac As String, Trep As String, Tindt As String
Application.ScreenUpdating = False

ColA = 1
ColB = 2
ColD = 4
UnCorrectedNameRow = 8 'Col H

UnCorrectedRowCounter = 2 'k
MainLoopCounter = 2 'v
tick = 0
With UnCorrectedSheet
For MainLoopCounter = 2 To _
UnCorrectedSheet.Cells(Rows.Count, ColA).End(xlUp).Row
'Goes through each row on UnCorrectedSheet
Dim shName As String
shName = UnCorrectedSheet.Cells(UnCorrectedRowCounter, UnCorrectedNameRow)
Set GoodSheet = Sheets(shName) ' shouldn't it be Set GoodSheet.name = etc?
GoodSheetLastRow = _
GoodSheet.Cells(Rows.Count, ColA).End(xlUp).Offset(1, 0).Row
Dim cRng As Range

'What are you trying to do here?'
Set cRng = _
GoodSheet.Columns(2).Find(UnCorrectedSheet.Cells(UnCorrectedRowCounter, ColB).Value)

If cRng Is Nothing Then 'Say What
Set cRng = Nothing ' ???

UnCorrectedSheet.Rows(UnCorrectedRowCounter).Copy _
Destination:=GoodSheet.Rows(GoodSheetLastRow)
tick = tick + 1

'If it does find a match value wise, it compares those two cells
'as well to see if they match
Else
'MsgBox "Already Exists"

FirstAddr = cRng.Address
Do
Set = GoodSheet.Columns(2).FindNext(cRng)
Loop While Not cRng Is Nothing And cRng.Address <> FirstAddr
'We got here because cRng IS not Nothing
' And cRng.Adress is Never <> FirstAddr in this loop
'So . . . Do while False and False

Tac = cRng.Address '
' Three Varients No telling what they'll wind up as
Trep = cRng.Offset(0, 2).Value
' I think it'll be Cols B, D, and E on the Uncorrected Sheet.
Tindt = cRng.Offset(0, 3).Value
If Trep <> UnCorrectedSheet.Cells(UnCorrectedRowCounter, ColD).Value And _
Tindt <> UnCorrectedSheet.Cells(UnCorrectedRowCounter, "E").Value Then
UnCorrectedSheet.Rows(UnCorrectedRowCounter).Copy _
Destination:=GoodSheet.Rows(GoodSheetLastRow)
tick = tick + 1
'If it finds that either of the two variables don't match -
'it will copy the row over
End If
'Does nothing else
End If
UnCorrectedRowCounter = UnCorrectedRowCounter + 1
Next MainLoopCounter
MsgBox "Records copied: " & tick
End With
Application.ScreenUpdating = True
End Sub
[/vba]

And edited the comments

I might have deleted a cRng, Hope I found all of 'em.

SamT

Edited 31-Oct-06 by geekgirlau. Reason: insert line breaks

[johnske]

Without an attachment I can only guess what your intentions are here.

Inside the Do Loop your FindNext is only advancing to the next value - doing nothing - then exiting the loop. As I said, I'm only guessing, but try this... [vba]Option Explicit
'
Sub Datamove()
'
Dim k As Long, tick As Long, EndRow As Long
Dim OtherSheet As Worksheet
Dim FirstAddress As String
Dim Cell As Range
'
Application.ScreenUpdating = False
'
With Worksheets("Uncorrected QC")
'
For k = 2 To .Range("A" & Rows.Count).End(xlUp).Row
'
Set OtherSheet = Sheets(.Range("H" & k).Text)
EndRow = OtherSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
'
Set Cell = OtherSheet.Columns(2).Find(.Range("B" & k), LookIn:=xlFormulas)
'
If Not Cell Is Nothing Then
FirstAddress = Cell.Address
Do
If Not Cell.Offset(0, 2) = .Range("D" & k) _
And Not Cell.Offset(0, 3) = .Range("E" & k) Then
.Rows(k).Copy OtherSheet.Rows(EndRow)
tick = tick + 1
End If
Set Cell = OtherSheet.Columns(2).FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
Else
.Rows(k).Copy OtherSheet.Rows(EndRow)
tick = tick + 1
End If
'
Next
'
MsgBox "Records copied: " & tick
End With
'
Application.ScreenUpdating = True
End Sub[/vba]

[lanhao]

ok - so based on how you have yours set up, if the two offset values don't match then it will copy the information over, right? I've run what you put up, adn it does the same thing that I have been running into, it is copying some rows over, even after they have already been copied. Any idea as to why it's still doing that?

By the way - that's for streamlining the code down - looks much neater the way you have it set up, and that's for the format on the find next command.

[johnske]

Probably because of the Else part of the statement (need example data), try cutting out[vba] Else
.Rows(k).Copy OtherSheet.Rows(EndRow)
tick = tick + 1[/vba]

[lanhao]

Shoudl there be a Do Loop under the else statement then? Because the way I see the loop set up it checks to see if Cell equals what teh range is, and if it does, it will check other cells in the same row to see if they match, if they don't it will copy the row, right?

[lanhao]

ok - actually, I am more perplexed now, on the test file - this is working fine, but on the main file where the important data is, it's copying over a few rows only everytime i click on the macro button.

The testrun file nothing is different with the actual code from the main one at all. Any thoughts?

[johnske]

Haven't looked at your attachment yet... Also, do you want an exact match or a partial match?

I've commented the previous code (from your original) to show what it's doing - is that what you want it to do? [vba]Option Explicit
'
Sub Datamove()
'
Dim k As Long, tick As Long, EndRow As Long
Dim OtherSheet As Worksheet
Dim FirstAddress As String
Dim Cell As Range
'
Application.ScreenUpdating = False
'
With Worksheets("Uncorrected QC") '< with this sheet
'
For k = 2 To .Range("A" & Rows.Count).End(xlUp).Row '< look at every entry in the A column
'
Set OtherSheet = Sheets(.Range("H" & k).Text) '< other sheet is a list of sheets in column H on this sheet
EndRow = OtherSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
'(end row is the last row on the other sheet)

'now look in the other sheet(s) column B for something that matches the entry in column B on this sheet
Set Cell = OtherSheet.Columns(2).Find(.Range("B" & k), LookIn:=xlFormulas)
'
If Not Cell Is Nothing Then '< if a match is found
FirstAddress = Cell.Address '< bookmark the 1st matches address
Do
'if the entries in columns D and E on both sheets aren't identical
If Not Cell.Offset(0, 2) = .Range("D" & k) _
And Not Cell.Offset(0, 3) = .Range("E" & k) Then

'copy the row on this sheet to a new row on the other sheet
.Rows(k).Copy OtherSheet.Rows(EndRow)

'count this action
tick = tick + 1
End If

'now look further in the other sheets column B for more entries that match
Set Cell = OtherSheet.Columns(2).FindNext(Cell)

'loop until there's either no more matches or
'we've returned to the bookmarked entry
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
Else

'if NO match is found, copy the row on this sheet to the other sheet
.Rows(k).Copy OtherSheet.Rows(EndRow)

'count this action
tick = tick + 1
End If
'now go to the next entry in column A on this sheet and repeat
Next
'
MsgBox "Records copied: " & tick
End With
'
Application.ScreenUpdating = True
End Sub[/vba]

[lanhao]

I need it to match the row values for those cells, if it does, then it doesn't copy it over, but it needs to check 3 cells to see if it a match - basically on the main workbook i am working on with this, Column B has the acct #, D is the rep who put the order in, E is the install date, and F is the comment about the order. I need it to see if any instance of the acct # on the destination page has teh same information of those variables match up.

If all of them come back as a match it won't copy it. The way you have it bookmarked pretyt much sums up what i am trying to do - but for some reason - 7 rows are copying themselves over, even though the information doesn't match between them.

[johnske]

Replace [VBA] Set Cell = OtherSheet.Columns(2).Find(.Range("B" & k), LookIn:=xlFormulas)[/VBA] with[VBA] Set Cell = OtherSheet.Columns(2).Find(.Range("B" & k), LookIn:=xlFormulas, LookAt:=xlWhole)[/VBA]and try

[lanhao]

Ok - so that is telling it to do what specifically (so i understand it for future ref)? I'm still getting 2 rows that are copying over repeatedly... I checked the information and the formats, everything else seems to be ok with it (they both have the same Acct number (Column B), but the other information does not match up at all.

Any thoughts as to why these two rows just contantly copy over, even though they are already on the target page?

[johnske]

What is the information in those two rows? (LookAt:=xlPart is the default)

[lanhao]

The information that the two rows only have in common is the Account number (Column B). They both have the same target worksheet since they both have the same person they report to. The install date, comments and rep names are all different.

[johnske]

I think your And should probably be an Or, I've also changed your "For K =" structure to a "For Each Entry" structure (2 to 3 times faster) - try this... [vba]Option Explicit
'
Sub Datamove()
'
Dim tick As Long, NextRow As Long
Dim OtherSheet As Worksheet
Dim FirstAddress As String
Dim Cell As Range, Entry As Range
'
Application.ScreenUpdating = False
'
With Worksheets("Uncorrected QC")
'
For Each Entry In .Range("A2", .Range("A" & Rows.Count).End(xlUp).Address)
'
Set OtherSheet = Sheets(.Range("H" & Entry.Row).Text)
NextRow = OtherSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
Set Cell = OtherSheet.Columns(2).Find(.Range("B" & Entry.Row), LookIn:=xlFormulas, LookAt:=xlWhole)
'
If Not Cell Is Nothing Then
FirstAddress = Cell.Address
Do
If Not Cell.Offset(0, 2) = .Range("D" & Entry.Row) _
Or Not Cell.Offset(0, 3) = .Range("E" & Entry.Row) _
Or Not Cell.Offset(0, 4) = .Range("F" & Entry.Row) Then
'
.Rows(Entry.Row).Copy OtherSheet.Rows(NextRow)
tick = tick + 1
'
End If
'
Set Cell = OtherSheet.Columns(2).FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
Else
'
.Rows(Entry.Row).Copy OtherSheet.Rows(NextRow)
tick = tick + 1
'
End If
Next
'
MsgBox "Records copied: " & tick
End With
'
Application.ScreenUpdating = True
End Sub[/vba]

[johnske]

I've just modified the last post to correct what would've given you a type mismatch error - try it now...

[lanhao]

it's still doing it for some reason - is there any code that you know of that would compare a row to a row specifically? because if there is, that might be the way to fix this unfortunately. I got the same redupes showing up for some reason

[SamT]

Try this one. It works on my box, anyway


[VBA]

Sub DataMove()

Dim TargetSheet As String
Dim TargetRow As Long
Dim CurrentRow As Long
Dim LastRow As Long

Dim ColA As Long
Dim ColB As Long
Dim ColD As Long
Dim ColK As Long

Let ColA = 1
Let ColB = 2
Let ColD = 4
Let ColK = 11

Let CurRow = 2
Let LastRow = ActiveSheet.Range("A65536").End(xlUp).Row

'''''''''''''''''''''
Do While Not (CurRow = LastRow + 1)
If Cells(CurRow, ColA) = Cells(CurRow, ColB) Then
If Cells(CurRow, ColA) = Cells(CurRow, ColD) Then
GoTo AllEqual ' Get out of this nested If
End If
Else ' We have a mismatch
TargetSheet = Cells(CurRow, ColK).Value
TargetRow = Sheets(TargetSheet).Range("A65536").End(xlUp).Row + 1
Rows(CurRow).Copy
Worksheets(TargetSheet).Rows(TargetRow).PasteSpecial Paste:=xlValues

AllEqual:
End If
CurRow = CurRow + 1
Loop
''''''''''''''''''''''
End Sub


[/VBA]