PDA

View Full Version : Solved: FindNext structure issues



lanhao
10-26-2006, 09:14 AM
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. :)

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


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

mdmackillop
10-26-2006, 01:08 PM
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
10-26-2006, 04:03 PM
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
10-26-2006, 04:53 PM
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
10-26-2006, 07:17 PM
Ianhao,
I did some straight string substitutions to make it a little more self documenting.


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


And edited the comments :wot

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

SamT

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

johnske
10-27-2006, 01:35 AM
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... 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

lanhao
10-27-2006, 10:31 AM
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
10-27-2006, 11:59 AM
Probably because of the Else part of the statement (need example data), try cutting out Else
.Rows(k).Copy OtherSheet.Rows(EndRow)
tick = tick + 1

lanhao
10-27-2006, 12:36 PM
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
10-27-2006, 01:09 PM
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
10-27-2006, 01:25 PM
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? 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

lanhao
10-27-2006, 01:42 PM
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
10-27-2006, 01:57 PM
Replace Set Cell = OtherSheet.Columns(2).Find(.Range("B" & k), LookIn:=xlFormulas) with Set Cell = OtherSheet.Columns(2).Find(.Range("B" & k), LookIn:=xlFormulas, LookAt:=xlWhole)and try

lanhao
10-27-2006, 02:14 PM
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
10-27-2006, 02:21 PM
What is the information in those two rows? (LookAt:=xlPart is the default)

lanhao
10-27-2006, 02:34 PM
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
10-27-2006, 03:03 PM
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... 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

johnske
10-27-2006, 03:22 PM
I've just modified the last post to correct what would've given you a type mismatch error - try it now...

lanhao
10-27-2006, 03:31 PM
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
10-27-2006, 05:00 PM
Try this one. It works on my box, anyway




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

johnske
10-27-2006, 05:20 PM
... I got the same redupes showing up for some reasonWell I cant get it to do that in the example file you've posted (using either And or Or). Post the details of the data that's being copied when it shouldn't be...

johnske
10-27-2006, 11:55 PM
OK, this variation concetenates the first NINE cells in each row and compares them with the first nine cells in each row on the other sheet and only copies if there is no match.

If there is still duplicates - all I can say is there must be pre-existing duplicates (the simpler alternative here - if your master file is the same as the example - would be to clear the contents of all the other sheets and start afresh each time the macro is run)
Option Explicit
'
Sub DataMove3()
'
Dim tick As Long, NextRow As Long
Dim OtherSheet As Worksheet
Dim FirstAddress As String
Dim FoundCell As Range, Entry As Range
'
Application.ScreenUpdating = False
'
With Worksheets("Uncorrected QC")
'
For Each Entry In .Range("B2", .Range("B" & Rows.Count).End(xlUp).Address)
'
Set OtherSheet = Sheets(.Range("H" & Entry.Row).Text)
NextRow = OtherSheet.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row
Set FoundCell = OtherSheet.Columns(2).Find(Entry, LookIn:=xlFormulas, LookAt:=xlWhole)
'
If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address
Do
If FoundCell.Offset(0, -1) & FoundCell.Offset(0, 0) & FoundCell.Offset(0, 1) & _
FoundCell.Offset(0, 2) & FoundCell.Offset(0, 3) & FoundCell.Offset(0, 4) & _
FoundCell.Offset(0, 5) & FoundCell.Offset(0, 6) & FoundCell.Offset(0, 7) _
<> _
Entry.Offset(0, -1) & Entry.Offset(0, 0) & Entry.Offset(0, 1) & _
Entry.Offset(0, 2) & Entry.Offset(0, 3) & Entry.Offset(0, 4) & _
Entry.Offset(0, 5) & Entry.Offset(0, 6) & Entry.Offset(0, 7) _
Then
'
.Rows(Entry.Row).Copy OtherSheet.Rows(NextRow)
tick = tick + 1
'
End If
'
Set FoundCell = OtherSheet.Columns(2).FindNext(FoundCell)
Loop Until FoundCell Is Nothing Or FoundCell.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

lanhao
10-30-2006, 08:08 AM
Hi Sam, I don't think this is what I was looking to have done - I am trying to check rows on target sheets to see if they match, not grab rows from one sheet and put them to different ones. I'm not following the structure that you have set up here on this. Is it designed to move from multiple sheets to one, or vice versa? I appreciate the suggestion and I did try it, but it isn't what I am looking for at this time.

lanhao
10-30-2006, 08:16 AM
Johjnske, thank you so much for the help on this, I think I see where you have the code going on this and I am going to be testing this out and seeing how well it runs. And I think I know why it's duping the rows actually now. I think it's because when it checks the first row with the same acct#, it compares it to another sheet, since the other row doesn't exactly match the first one, it will copy it, then when it hits the second row, it will not count the first row as copied over.

The code works great though, it's nice and quick, just have to figure out how to avoid the duping (I did clear the info out from the target pages, and it still was doing the duping of rows). Any suggestions on that by chance to have that stop at all? (Maybe put in a flag that once it copies over to the target sheets it adds a value to another cell on the main page telling it to ignore the row if it already was copied over?)

johnske
10-30-2006, 06:15 PM
You're right - it needs a flag (I couldn't get duplicates on the sample data provided - I had to write entries that were similar but different to get them :))...

Try this now Option Explicit
'
Sub DataMove3()
'
Dim tick As Long, NextRow As Long
Dim OtherSheet As Worksheet
Dim FirstAddress As String
Dim FoundCell As Range, Entry As Range
Dim CopyExists As Boolean
'
Application.ScreenUpdating = False
'
With Sheets("Uncorrected QC")
'
For Each Entry In .Range("B2", .Range("B" & Rows.Count).End(xlUp).Address)
'
Set OtherSheet = Sheets(.Range("H" & Entry.Row).Text)
NextRow = OtherSheet.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row
'
Set FoundCell = OtherSheet.Columns("B").Find(Entry, LookIn:=xlFormulas, LookAt:=xlWhole)
'
If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address
'
Do
With FoundCell
If .Offset(0, -1) & .Offset(0, 0) & .Offset(0, 1) & _
.Offset(0, 2) & .Offset(0, 3) & .Offset(0, 4) & _
.Offset(0, 5) & .Offset(0, 6) & .Offset(0, 7) _
= _
Entry.Offset(0, -1) & Entry.Offset(0, 0) & Entry.Offset(0, 1) & _
Entry.Offset(0, 2) & Entry.Offset(0, 3) & Entry.Offset(0, 4) & _
Entry.Offset(0, 5) & Entry.Offset(0, 6) & Entry.Offset(0, 7) _
Then
CopyExists = True
Exit Do
Else
CopyExists = False
End If
End With
'
Set FoundCell = OtherSheet.Columns("B").FindNext(FoundCell)
Loop Until FoundCell Is Nothing Or FoundCell.Address = FirstAddress
'
If CopyExists = False Then
.Rows(Entry.Row).Copy OtherSheet.Rows(NextRow)
tick = tick + 1
End If
'
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

lanhao
10-31-2006, 08:16 AM
Well, i put in the flag idea, which worked out great, made life much easier, however this code is not being scrapped at alll, what I'm doing with it is that when the errors listed are cleaned up, it will remove the rows in question from both sheets. For that, I really thank you for your patience on working with me on this - it was a weird issue. The only thing left I have to do is have it check date information now (which I think I saw some code help on in here somewhere).

I also really appreciate the fact that the admins and staff here have been helpful with suggestions instead of browbeating that I have run into one or two other places. So thank you again for everything.

As for the flag - I actually set the column to invisible when it's done running the copy, so it can't even be seen by people (which helps with the 'break-proofing' that my bosses asked to have implemented).

johnske
10-31-2006, 01:01 PM
Did you try my last piece of code? It has a Boolean flag 'CopyExists' in the code that doesn't interfere with the spreadsheet...

What exactly do you mean by "have it check date information"?

lanhao
10-31-2006, 04:17 PM
well, basically I am putting in a little clean-up macro into the spreadsheet for the leads, so this way - if stuff that doesn't get taken care of by the reps, it gets moved over to a different spreadsheet and cleared off of the stuff that needs fixing list. The code that you put up there I am going to actually test out in a little bit, been busy getting other things wrapped up adn ready to go for the people that are going to make use of some other sheets I put together.