View Single Post
  #6   Report Post  
mjack003
 
Posts: n/a
Default


Sweet...thanks for the help Dave. This is way off the subject but could
you give me some suggestions on how to clean up this code? For some
reason it keeps freezing on my computer...basically four loops and
exit. Worked just fine when I only had it as one loop but had to take
one long list and shorten it into four lists on my audit sheet. Its
connected to a command button on "Rows" sheet.

Here it is:

Private Sub CommandButton3_Click()
Dim myRng As Range
Dim myCell As Range
Dim myInputRng As Range
Dim FoundCell As Range
Dim rowRng As Range
Dim pop As String
pop = MsgBox("This may take a few minutes...are you sure you want to
populate the audit?", vbYesNo)
If pop = vbYes Then

Application.ScreenUpdating = False
'use the same name for consistency
Set myRng = Worksheets("rows").Range("myrng")

Set rowRng = Worksheets("Audit").Range("B2:B651")
rowRng.ClearContents

With Worksheets("Audit")
Set myInputRng = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
End With
For Each myCell In myInputRng.Cells
Set FoundCell = myRng.Cells.Find(what:=myCell.Value, _
lookat:=xlWhole, LookIn:=xlValues, _
MatchCase:=False, searchorder:=xlByRows)
If FoundCell Is Nothing Then
'myCell.Offset(0, 1).Value = "Not found" Commented out so cell is
left blank
Else
myCell.Offset(0, 1).Value = FoundCell.column - 1
End If
Next myCell
Set rowRng = Worksheets("Audit").Range("E2:E651")
rowRng.ClearContents

With Worksheets("Audit")
Set myInputRng = .Range("D2", .Cells(.Rows.Count, "D").End(xlUp))
End With
For Each myCell In myInputRng.Cells
Set FoundCell = myRng.Cells.Find(what:=myCell.Value, _
lookat:=xlWhole, LookIn:=xlValues, _
MatchCase:=False, searchorder:=xlByRows)
If FoundCell Is Nothing Then
Else
myCell.Offset(0, 1).Value = FoundCell.column - 1
End If
Next myCell

Set rowRng = Worksheets("Audit").Range("H2:H651")
rowRng.ClearContents

With Worksheets("audit")
Set myInputRng = .Range("G2", .Cells(.Rows.Count, "G").End(xlUp))
End With
For Each myCell In myInputRng.Cells
Set FoundCell = myRng.Cells.Find(what:=myCell.Value, _
lookat:=xlWhole, LookIn:=xlValues, _
MatchCase:=False, searchorder:=xlByRows)
If FoundCell Is Nothing Then
Else
myCell.Offset(0, 1).Value = FoundCell.column - 1
End If
Next myCell

Set rowRng = Worksheets("Audit").Range("K2:K651")
rowRng.ClearContents

With Worksheets("audit")
Set myInputRng = .Range("J2", .Cells(.Rows.Count, "J").End(xlUp))
End With
For Each myCell In myInputRng.Cells
Set FoundCell = myRng.Cells.Find(what:=myCell.Value, _
lookat:=xlWhole, LookIn:=xlValues, _
MatchCase:=False, searchorder:=xlByRows)
If FoundCell Is Nothing Then
Else
myCell.Offset(0, 1).Value = FoundCell.column - 1
End If
Next myCell


Application.ScreenUpdating = True
MsgBox "Done!"

Else
If pop = vbNo Then
Exit Sub
End If
End If
End Sub


--
mjack003
------------------------------------------------------------------------
mjack003's Profile: http://www.excelforum.com/member.php...fo&userid=5141
View this thread: http://www.excelforum.com/showthread...hreadid=469775