Help with code, partially working

[i_gencheva]

I need some assistance from you. Have 2 sheets, named Sheet1 and Sheet2. In sheet2 in column C from C5 to end i could enter some text or date. Then i need from the same sheet, Sheet2 to find corresponding data from the cells A and B in the filled row with cells from columns E and and B in Sheet 1. Then to paste the entered text or date from Sheet2 to column F in sheet1 on the corresponding found row. Here is the code i have so far but it works only for row 5 from Sheet2:

Private Sub CommandButton2_Click() 
    Dim sht As Worksheet, Rng As Range, r As Range 
    Dim bCellsFilled As Boolean 
    Set sht = ActiveSheet 
    Set Rng = sht.Range(sht.Range("C5"), sht.Cells(sht.Rows.Count, "C").End(xlUp)) 
    bCellsFilled = True 
     
    For Each r In Rng 
        If r.Value = "" Then 
            bCellsFilled = False 
        End If 
    Next r 
     
    If bCellsFilled = True Then 
        If Worksheets("Sheet2").Range("A5").Value = Worksheets("Sheet1").Range("E5").Value Then 
            If Worksheets("Sheet2").Range("B5").Value = Worksheets("Sheet1").Range("B5").Value Then 
                Worksheets("Sheet2").Range("C5").Copy Worksheets("Sheet1").Range("F5") 'Copy Then
                Worksheets("Sheet1").Range("E5").ClearContents 
                Worksheets("Sheet2").Range("C5").ClearContents 
            End If 
        End If 
    End If

 

[iliace]

It sounds like you want the If logic to be inside the For Each loop. Try this, on a copy of your data:

Public Sub RangeCopy()
  Dim sht As Worksheet, Rng As Range, r As Range
  
  Set sht = ActiveSheet
  Set Rng = sht.Range(sht.Range("C5"), sht.Cells(sht.Rows.Count, "C").End(xlUp))


  For Each r In Rng.Cells
    If r.Value <> "" Then
      If r.Offset(0, -2).Value = Worksheets("Sheet1").Range(r.Offset(0, 2).Address).Value And _
        r.Offset(0, -1).Value = Worksheets("Sheet1").Range(r.Offset(0, -1).Address).Value Then
            r.Copy Worksheets("Sheet1").Range(r.Offset(0, 3).Address) 'Copy Then
            Worksheets("Sheet1").Range(r.Offset(0, 2).Address).ClearContents
            r.ClearContents
      End If
    End If
  Next r
End Sub

I don't think you need the bCellsFilled in this context, unless there is further logic surrounding that. The way you have it written right now, it will never go back to True once it hits a False.

 

[i_gencheva]

Thank you for you reply.
I am sorry but i can't make it work. If it makes sense in Value in Sheet2, Range B5:B is string, and in A5:A is date or string. If it is possible to enter a INDEX/MATCH or something like this to make it working..

I made also other code, but it makes fol: if is entered date in C3:C, copy Value from A1:A and paste in the same sheet. But i need to search for both Values from A and B on the entered row if are equal to values in Sheet1 and paste on the corresponding row. Here i can't make the part working

Dim sht As Worksheet, Rng As Range, r As Range
Set sht = ActiveSheet
Set Rng = sht.Range(sht.Range("C3"), sht.Cells(sht.Rows.Count, "C").End(xlUp))


  For Each Cel In Rng
    If Cel.Value <> "" Then Cel.Offset(0, 5).Value = Cel.Value
    If Cel.Value <> "" Then Cel.Offset(0, 6).Value = Cel.Offset(0, -1).Value
    If Cel.Value <> "" Then Cel.Offset(0, -2).ClearContents
    
Next

 

[i_gencheva]

I can't edit my post so, i reply yours again. I played with your code and it gives error o the following rows:

 If r.Offset(0, -2).Value = Worksheets("Sheet1").Range(r.Offset(0, 2).Address).Value And _
        r.Offset(0, -1).Value = Worksheets("Sheet1").Range(r.Offset(0, -1).Address).Value Then
            r.Copy Worksheets("Sheet1").Range(r.Offset(0, 3).Address) 'Copy Then
            Worksheets("Sheet1").Range(r.Offset(0, 2).Address).ClearContents

"Object variable or With block variable not set"

 

[iliace]

You would have to troubleshoot to figure out exactly what object variable is not set.

When you are on the error line, can you go in Immediate window and type\

Debug.Print r.Address, r.Value

 

[i_gencheva]

So this makes the trick but only if the cell C5 is filled, if is made an entry in C6 it is not working.

Public Sub RangeCopy()
  Dim sht As Worksheet, Rng As Range, r As Range
  
  Set sht = ActiveSheet
  Set Rng = sht.Range(sht.Range("C5"), sht.Cells(sht.Rows.Count, "C").End(xlUp))


  For Each r In Rng
   
   If r.Value <> "" Then

      If r.Offset(0, -2).Value = Worksheets("Sheet1").Range(r.Offset(0, 2).Address).Value And _
        r.Offset(0, -1).Value = Worksheets("Sheet1").Range(r.Offset(0, -1).Address).Value Then
            r.Copy Worksheets("Sheet1").Range(r.Offset(0, 3).Address) 'Copy Then
            Worksheets("Sheet1").Range(r.Offset(0, 2).Address).ClearContents
            r.ClearContents
      End If
    End If
  Next r
End Sub

 

[iliace]

So this makes the trick but only if the cell C5 is filled, if is made an entry in C6 it is not working.

Can you clarify what you mean by "not working"? I tried it on an example, and it is definitely copying when the two criteria are met. If I have nothing in C5 but something in C6 (and the other criteria match) it still works fine.

 

[i_gencheva]

The code is behind a command button. I think i figure out why is not working for me in C6. In sheet1 data is not entered in the same row as in sheet 2 except in C5. The idea in this code is to search the row where the to conditions are met, and it is not exactly the same row as in sheet 2. If entered data in C6 in Sheet2, the code is searching from the same row A and B values if are equal with values from E and B in sheet 1, finds that row and paste in F on the same row. In my workbook if entered in C6, the corresponding data is in row 7, so paste should be in F7.
So how to make it search

 

[i_gencheva]

I think this is the final code. Thank you for your cooperation

Private Sub CommandButton2_Click()

Dim sht As Worksheet, Rng As Range, r As Range, Rng1 As Range, rng2 As Range, sht1 As Worksheet, rngRef_1 As Range, rngRef_2 As Range
Set sht = ActiveSheet
Set sht1 = Sheets("Sheet1")
Set Rng = sht.Range(sht.Range("C5"), sht.Cells(sht.Rows.Count, "C").End(xlUp))
Set Rng1 = sht1.Range(sht1.Range("E5"), sht1.Cells(sht1.Rows.Count, "E").End(xlUp))
Set rng2 = sht1.Range(sht1.Range("B5"), sht1.Cells(sht1.Rows.Count, "B").End(xlUp))
 
 For Each rngRef_1 In Rng1
 For Each rngRef_2 In rng2
   
   For Each r In Rng
  
  If r.Value <> "" Then
 
      If r.Offset(0, -2).Value = rngRef_1.Value And r.Offset(0, -1).Value = rngRef_2.Value Then
            r.Copy sht1.Range(rngRef_1.Offset(0, 1).Address) 'Copy Then
            sht1.Range(rngRef_1.Offset(0, 0).Address).ClearContents
            r.ClearContents
            
      End If
      End If
      Next
  Next
   Next
End Sub