Trying to compare columns only if Column B and D are empty

[PGNewbie]

I have a massive spread sheet that is missing data. I need to compare it with data in another workbook, but my criteria is to only compare column C from both workbooks if columns B and D are empty in workbook 1. If it is empty and a match is found then it needs to copy over the data from column B and D of workbook 2 on to columns B and D in workbook 1. I don't want it make a match if workbook 1 has values in Columns B and D. Also if multiple matches are found it needs to add a new row for additional matches and only copy Columns B, C and D from workbook 2 underneath the row matched in workbook 1.

Thank you for taking a look!

 

[PGNewbie]

I created the following code, after fixing all the errors, when the code runs nothing happens.

Sub missingdevicename()

Dim c As Range, rng1 As Range

Dim d As Variant
Dim sht1 As Worksheet, sht2 As Worksheet
Dim lr As Long

Set sht1 = ActiveWorkbook.Sheets("Sheet1")
Set sht2 = ActiveWorkbook.Sheets("Sheet2")
lr = sht2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = sht2.Range("C2:C" & lr)

For Each c In sht1.Range("C2", Range("C" & Rows.Count).End(xlUp))


  If c.Offset(, -1) = 0 And c.Offset(, 1) = 0 Then
 
  d = Application.Match(c, rng1)
 
    If IsNumeric(d) Then
 
     c.Offset(, -1).Value = sht2.Range("B" & d).Value
     c.Offset(, 1).Value = sht2.Range("D" & d).Value
    c.Interior.Color = 65535
    End If
  End If
 
Next c
End Sub

 

[DanteAmor]

Try this.

only compare column C from both workbooks if columns B and D are empty in workbook 1

Sub CompareColumns()
  Dim wb1 As Workbook, wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, c As Variant, sStr As Variant
  Dim i As Long, j As Long, k As Long, dic As Object
  
  Set wb1 = Workbooks("Book1.xlsx")
  Set wb2 = Workbooks("Book2.xlsx")
  Set sh1 = wb1.Sheets(1)
  Set sh2 = wb2.Sheets(1)
  Set dic = CreateObject("Scripting.Dictionary")
  dic.CompareMode = vbTextCompare
  
  a = sh1.Range("B2:D" & sh1.Range("C" & Rows.Count).End(xlUp).Row).Value2
  b = sh2.Range("B2:D" & sh2.Range("C" & Rows.Count).End(xlUp).Row).Value2
  ReDim c(1 To UBound(a) + UBound(b), 1 To 3)
  
  For i = 1 To UBound(b)
    dic(b(i, 2)) = dic(b(i, 2)) & b(i, 1) & "|" & b(i, 3) & "@"
  Next
  
  j = 1
  For i = 1 To UBound(a)
    c(j, 1) = a(i, 1)
    c(j, 2) = a(i, 2)
    c(j, 3) = a(i, 3)
    If a(i, 1) = "" And a(i, 3) = "" Then
      If dic.exists(a(i, 2)) Then
        sStr = Split(dic(a(i, 2)), "@")
        For k = 0 To UBound(sStr) - 1
          c(j, 1) = Split(sStr(k), "|")(0)
          c(j, 2) = a(i, 2)
          c(j, 3) = Split(sStr(k), "|")(1)
          j = j + 1
        Next
      End If
    Else
      j = j + 1
    End If
  Next
  sh1.Range("B2").Resize(j, 3).Value = c
End Sub

 

[PGNewbie]

Try this.

Sub CompareColumns()
  Dim wb1 As Workbook, wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, c As Variant, sStr As Variant
  Dim i As Long, j As Long, k As Long, dic As Object

  Set wb1 = Workbooks("Book1.xlsx")
  Set wb2 = Workbooks("Book2.xlsx")
  Set sh1 = wb1.Sheets(1)
  Set sh2 = wb2.Sheets(1)
  Set dic = CreateObject("Scripting.Dictionary")
  dic.CompareMode = vbTextCompare

  a = sh1.Range("B2:D" & sh1.Range("C" & Rows.Count).End(xlUp).Row).Value2
  b = sh2.Range("B2:D" & sh2.Range("C" & Rows.Count).End(xlUp).Row).Value2
  ReDim c(1 To UBound(a) + UBound(b), 1 To 3)

  For i = 1 To UBound(b)
    dic(b(i, 2)) = dic(b(i, 2)) & b(i, 1) & "|" & b(i, 3) & "@"
  Next

  j = 1
  For i = 1 To UBound(a)
    c(j, 1) = a(i, 1)
    c(j, 2) = a(i, 2)
    c(j, 3) = a(i, 3)
    If a(i, 1) = "" And a(i, 3) = "" Then
      If dic.exists(a(i, 2)) Then
        sStr = Split(dic(a(i, 2)), "@")
        For k = 0 To UBound(sStr) - 1
          c(j, 1) = Split(sStr(k), "|")(0)
          c(j, 2) = a(i, 2)
          c(j, 3) = Split(sStr(k), "|")(1)
          j = j + 1
        Next
      End If
    Else
      j = j + 1
    End If
  Next
  sh1.Range("B2").Resize(j, 3).Value = c
End Sub

Hey DanteAmor, this actually deleted the rows that had had a value in C but empty cells in B and D.

 

[DanteAmor]

Hey DanteAmor, this actually deleted the rows that had had a value in C but empty cells in B and D.

You could put the sample of your test data before the macro (book1 and book2).
And the result of the macro.

 

[PGNewbie]

You could put the sample of your test data before the macro (book1 and book2).
And the result of the macro.

I manually checked the rows that were deleted in workbook 1, so the code will delete the row if it does not find a match in workbook 2. Sorry I haven't been able to create the sample workbooks. As soon as I can I'll upload it.

 

[DanteAmor]

Also if multiple matches are found it needs to add a new row for additional matches and only copy Columns B, C and D from workbook 2 underneath the row matched in workbook 1.

The macro does not delete records, on the contrary it adds new data in columns B, C and D.
But if you have data in A, E, F, etc. That data remains in place.

In your example, also put how you want the result.