Gil
04-26-2010, 07:08 AM
Hello
Trying to adapt and use a previously supplied solution for this search I have got to the following stage and am stumped.The search should look for data in 2 sheets and supply a result before moving to the next item.
The Dim c is giving me the first problem
Option Explicit
Private Sub GetMapping_Click()
Sheet1.Select
Columns("B:M").ClearContents
Columns("A:A").Select
Selection.Replace What:="1/", Replacement:="1/ ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Dim lngLastRow As Long
lngLastRow = Range("A" & Rows.Count).End(xlUp).Row
Cells(lngLastRow - 0, 1).Select
Dim Sh
Dim Fnd As Range
Dim c As Range
Dim FirstAddress As String
Dim SecAdd As String
Dim x As Long
Dim arr, a
arr = (Array("Sheet2", "Sheet3"))
Set c = Cells.Find((Split(c)(1)), LookAt:=xlWhole)
If Not Fnd Is Nothing Then FirstAddress = c.Address
Do
For Each a In arr
Set Sh = Sheets(a)
Set Fnd = Sh.Cells(3, Fnd.Column - 0) & "-" & Fnd.Offset(, -1) & "-" & Fnd.Offset(, -2)
ActiveCell.Offset(, 2).Font.Bold = True
ActiveCell.Offset(, 2).Font.Color = -16776961
If Not Fnd Is Nothing Then
SecAdd = Fnd.Address
'Inner loop ***************
Do
Set tgt = Cells(c.Row, Columns.Count).End(xlToLeft).Offset(, 1)
If tgt.Column < 6 Then Set tgt = Cells(c.Row, 5)
With tgt
.Offset(1) = Sh.Name
.Offset(, 2).Font.Bold = True
.Offset(, 2).Font.Color = -16776961
.Value = Sh.Cells(3, Fnd.Column - 0) & "-" & Fnd.Offset(, -1) & "-" & Fnd.Offset(, -2)
End With
Set Fnd = Sh.Cells.FindNext(Fnd)
Loop While Not Fnd Is Nothing And Fnd.Address <> SecAdd
'********************
Else
Set tgt = Cells(c.Row, Columns.Count).End(xlToLeft).Offset(, 1)
If tgt.Column < 6 Then Set tgt = Cells(c.Row, 8)
With tgt
.Value = "Not found"
.Font.Bold = True
.Font.Color = -16776961
End With
End If
Set c = Cells(c.Row, Columns.Count).End(xlToLeft).Offset(, 1)
Next
ActiveCell.Offset(-8, 0).Select
Loop While Not c Is Nothing And c.Address <> FirstAddress
Columns("A:A").Select
Selection.Replace What:="1/ ", Replacement:="1/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Private Sub Reset()
Columns("A:A").Select
Selection.Replace What:="1/ ", Replacement:="1/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Points noted and hopefully corrected. Now compile errror Variable not defined (tgt)
Trying to adapt and use a previously supplied solution for this search I have got to the following stage and am stumped.The search should look for data in 2 sheets and supply a result before moving to the next item.
The Dim c is giving me the first problem
Option Explicit
Private Sub GetMapping_Click()
Sheet1.Select
Columns("B:M").ClearContents
Columns("A:A").Select
Selection.Replace What:="1/", Replacement:="1/ ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Dim lngLastRow As Long
lngLastRow = Range("A" & Rows.Count).End(xlUp).Row
Cells(lngLastRow - 0, 1).Select
Dim Sh
Dim Fnd As Range
Dim c As Range
Dim FirstAddress As String
Dim SecAdd As String
Dim x As Long
Dim arr, a
arr = (Array("Sheet2", "Sheet3"))
Set c = Cells.Find((Split(c)(1)), LookAt:=xlWhole)
If Not Fnd Is Nothing Then FirstAddress = c.Address
Do
For Each a In arr
Set Sh = Sheets(a)
Set Fnd = Sh.Cells(3, Fnd.Column - 0) & "-" & Fnd.Offset(, -1) & "-" & Fnd.Offset(, -2)
ActiveCell.Offset(, 2).Font.Bold = True
ActiveCell.Offset(, 2).Font.Color = -16776961
If Not Fnd Is Nothing Then
SecAdd = Fnd.Address
'Inner loop ***************
Do
Set tgt = Cells(c.Row, Columns.Count).End(xlToLeft).Offset(, 1)
If tgt.Column < 6 Then Set tgt = Cells(c.Row, 5)
With tgt
.Offset(1) = Sh.Name
.Offset(, 2).Font.Bold = True
.Offset(, 2).Font.Color = -16776961
.Value = Sh.Cells(3, Fnd.Column - 0) & "-" & Fnd.Offset(, -1) & "-" & Fnd.Offset(, -2)
End With
Set Fnd = Sh.Cells.FindNext(Fnd)
Loop While Not Fnd Is Nothing And Fnd.Address <> SecAdd
'********************
Else
Set tgt = Cells(c.Row, Columns.Count).End(xlToLeft).Offset(, 1)
If tgt.Column < 6 Then Set tgt = Cells(c.Row, 8)
With tgt
.Value = "Not found"
.Font.Bold = True
.Font.Color = -16776961
End With
End If
Set c = Cells(c.Row, Columns.Count).End(xlToLeft).Offset(, 1)
Next
ActiveCell.Offset(-8, 0).Select
Loop While Not c Is Nothing And c.Address <> FirstAddress
Columns("A:A").Select
Selection.Replace What:="1/ ", Replacement:="1/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Private Sub Reset()
Columns("A:A").Select
Selection.Replace What:="1/ ", Replacement:="1/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Points noted and hopefully corrected. Now compile errror Variable not defined (tgt)