Trying to set two columns as a criteria in Range

[PGNewbie]

I have two worksheets with two columns in each that need to be compared. If there is a match then certain columns from the row need to be copied over to a new sheet. My criteria is being seen as individual criteria and not combined as one criteria. This is creating duplicate worksheets with different names and I am still getting incorrect data in the sheets.

Sub CreateNewSheet()
Dim d As Range,
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim Condition As Worksheet
    Dim lastrow2 As Long
    
    

    Set Source = ActiveWorkbook.Worksheets("Input")
    Set Condition = ActiveWorkbook.Worksheets("Top10NoisiestDevices")
    
    
    'This will start copying data to Target sheet at row 3
    
        
    For Each d In Condition.Range("A2:B11") 'specifiy condition
      
    'create worksheet for each value in condition
      
    Set Target = Sheets.Add(after:=ActiveSheet)
      
    Target.Name = "Device-" & d.Value
    
      
    'add code to show client name on line A1
    
    Target.Range("A1").Value = d.Offset(, 4).Value
    Target.Range("A1:L1").Merge
    Target.Range("A1").Interior.ColorIndex = 45
        
        
        
    'Sheets("Input").Range("A1:AE1").Copy Target.Range("A2")
    
    [A2:L2] = Split("Start_Time Host_Name Client_Name Message Count Probe Source Origin Status End_Time Ack_By Ticket")
    Target.Range("A2:L2").Interior.ColorIndex = 44
            
    'lastrow2 = Target.Cells(Target.Rows.Count, "A").End(xlUp).Row
    
  
      
        For Each c In Source.Range("K2:L6893")
            
        lastrow2 = Target.Cells(Target.Rows.Count, "A").End(xlUp).Row
        
            If c.Value = d.Value Then
          
                  
                    Source1.Cells(c.Row, 5).Copy Target.Cells(lastrow2 + 1, 1)
                    Source1.Cells(c.Row, 11).Copy Target.Cells(lastrow2 + 1, 2)
                    Source1.Cells(c.Row, 22).Copy Target.Cells(lastrow2 + 1, 3)
                    Source1.Cells(c.Row, 6).Copy Target.Cells(lastrow2 + 1, 4)
                    Source1.Cells(c.Row, 8).Copy Target.Cells(lastrow2 + 1, 5)
                    Source1.Cells(c.Row, 17).Copy Target.Cells(lastrow2 + 1, 6)
                    Source1.Cells(c.Row, 12).Copy Target.Cells(lastrow2 + 1, 7)
                    Source1.Cells(c.Row, 13).Copy Target.Cells(lastrow2 + 1, 8)
                    Source1.Cells(c.Row, 3).Copy Target.Cells(lastrow2 + 1, 9)
                    Source1.Cells(c.Row, 4).Copy Target.Cells(lastrow2 + 1, 10)
                    Source1.Cells(c.Row, 21).Copy Target.Cells(lastrow2 + 1, 11)
                    Source1.Cells(c.Row, 28).Copy Target.Cells(lastrow2 + 1, 12)
            
                
            End If
              
        Next c
    Rows("3:3").Select
    ActiveWindow.FreezePanes = True
    Range("A1").Select
    'Zoom to first cell
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1

    Next d
    End Sub

 

[yky]

I took a quick glance at your code and found no IF statement in it. You said "If there is a match then certain columns from the row need to be copied". That requires your code to have something like "IF match is found THEN copy."

 

[PGNewbie]

I took a quick glance at your code and found no IF statement in it. You said "If there is a match then certain columns from the row need to be copied". That requires your code to have something like "IF match is found THEN copy."

The IF statement is in the second For Each statement. I was able to find a solution. If interested, I'll post it.

Thanks for taking a look ?