making this automatic

[everscern]

Private Sub Button24_Click()
Dim txt As String, r As Range

   If WorksheetFunction.CountA(Range("b3:b9")) <> 7 Then Exit Sub
   Range("b10") = Empty
   txt = Range("b3").Text & "_" & Range("b4").Text & "_" & Range("b5").Text & "_" & Range("b6").Text & "_" & Range("b7").Text & "_" & Range("b8").Text & "_" & Range("b9").Text
   For Each r In Range("s3", Cells(3, Columns.Count).End(xlToLeft))
      If txt = r.Text & "_" & r.Offset(1).Text & "_" & r.Offset(2).Text & "_" & r.Offset(3).Text & "_" & r.Offset(4).Text & "_" & r.Offset(5).Text & "_" & r.Offset(6).Text Then
         Range("b10").Value = r.Offset(7).Value
         Exit For
      End If
   Next

End Sub

hi. how do i go about making this automatic, maybe thru looping? without having to depend on a button?

Thanks!

 

[jindon]

delete previous code before you paste new code....

 

[everscern]

i deleted the previous code and added the code you created. Pls refer to the above.

 

[jindon]

You can't do it...

You can not have same event driven subroutine in a module....

Delete all the code in Worksheet_Change event code and replace with this

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target.Cells(1,1)
   If Not Intersect(.Cells, Range("b3:b9")) Is Nothing Then
      Range("b24") = Empty     
      For i = 3 To 9 : txt = txt & Cells(i,"b").Value & "_" : Next
      For Each r In Range("s3",Cells(3,Columns.Count).End(xlToLeft))
         For i = 0 To 6 : txt2 = txt2 & r.Offset(i).Value & "_" : Next
         If txt = txt2 Then 
            Range("b10").Value = r.Offset(7).Value
            Exit For
         End If
      Next
   ElseIf Not Intersect(.Cells,Range("b17:b23")) Is Nothing Then
      Range("b24") = Empty
      For i = 17 To 23 : txt = txt & Cells(i,"b").Value & "_" : Next
      For Each r In Range("s17",Cells(17,Columns.Count).End(xlToLeft))
         For i = 0 To 6 : txt2 = txt2 & r.Offset(i).Value & "_" : Next
         If txt = txt2 Then
            Range("b24").VAlue = r.Offset(7).Value
            Exit For
         End If
      Next
   End If
End With
Application.EnableEvents = True
End Sub

 

[everscern]

thanks for your patience. but now it shows : complie error; end without block if. it highlites this line: Private Sub Worksheet_Change(ByVal Target As Range)

 

[jindon]

OK
Code has been edited.

copy it and try again.

 

[everscern]

er.. the code?

 

[jindon]

Yeah, the last code I posted.

 

[everscern]

hi. it worked well. but the problem is i was not able to compare with column T. I was only able to compare with column S.

thanks for your patience. we're getting there

 

[jindon]

You shoud have posted this in the first place....
Delete all the code and replace with this

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Long, y As Long, txt1 As String, txt2 As STring, r As Range
With Target.Cells(1,1)
    If .Column <> 2 Then Exit Sub
    If IsEmpty(.Offset(,-1)) Then Exit Sub
    With .CurrentRegion
       x = .Row + 1 : y = .Row + .Rows.Count - 1 : z = y - x
    End With
    If WorksheetFunction.CountA(Cells(x, "b").Resize(z)) <> z Then Exit Sub
    Application.EnableEvents = False
    Cells(y,"b").ClearContents 
    For i = x To y - 1 : txt = txt & Cells(i,"b").Value & "_" : Next
    With .Offset(,3).CurrentRegion
       For i = 2 To .Columns.Count
          For ii = x To y - 1 : txt2 = txt2 & Cells(ii, .Columns(i)).Value & "_" : Next
          If txt = txt2 Then
             Cells(y,"b").Value = Cells(y,.Columns(i)).Value
             Exit For
          End If
       Next
    End With
    Application.EnableEvents = True
End With
End Sub

 

[everscern]

sorry to reply after so long, but it still does not work. the figure in red does not show