If it doesn't find anything then it becomes green

ASadStudent

New Member
Joined
Oct 26, 2022
Messages
20
Office Version
  1. 365
Platform
  1. Windows
Hello everyone, the code I am using right now copies data from 1 excel file to another excel file. These files are called "omzet" and "maandafsluiting" and the sheets are just called Sheet1.
The way the macro works is that it looks at the B row on both excel files and if the name on both files is the same it copies the data it has (Which is in the N row of the "omzet" file) to the place where the data needs to go (Which is in the F row of the "maandafsluiting" file).

My question was if it is possible to make the product name in the "omzet" file red if it can't find a similar name in the other file.
The reason I need this function is so that if a new product gets sold that isn't in the "maandafsluiting" file yet then I can easily find it and add it. I can also find out if some names aren't perfectly the same so I can change that as well.

Beneath here is my macro and printscreens of what both excel files look like.
Thanks a lot for helping me solve this problem!


My macro:
VBA Code:
Sub Kijken()
    Dim omzet As Worksheet: Set omzet = Workbooks.Item("Omzet").Sheets("Sheet1")
    Dim Maandafsluiting As Worksheet: Set Maandafsluiting = Workbooks.Item("Maandafsluiting").Sheets(1)
   
    Dim data As Variant, lr As Long, d As Object, key As String, rw As Long
 
    lr = omzet.Cells(Rows.Count, 2).End(3).Row
    data = omzet.Cells(1, 1).Resize(lr, 14).Value
   
    Set d = CreateObject("Scripting.Dictionary")
   
    For rw = LBound(data) To UBound(data)
        If data(rw, 14) <> 0 Then
            key = data(rw, 2)
            If Not d.exists(key) Then
                d(key) = data(rw, 14)
            End If
        End If
    Next rw
   
    lr = Maandafsluiting.Cells(Rows.Count, 2).End(3).Row
    data = Maandafsluiting.Cells(1, 1).Resize(lr, 6).Formula
     
    For rw = LBound(data) To UBound(data)
        key = data(rw, 2)
        If d.exists(key) Then
            data(rw, 6) = d(key)
        End If
    Next rw
 
    Maandafsluiting.Cells(1, 6).Resize(UBound(data)).Formula = Application.Index(data, 0, 6)
End Sub

Omzet
1668683991294.png


Maand afsluiting:
1668684027873.png
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Try this:

VBA Code:
Sub Kijken()
  Dim omzet As Worksheet, Maandafsluiting As Worksheet
  Dim data As Variant, ky As Variant
  Dim lr As Long, rw As Long
  Dim d As Object, d2 As Object
  Dim rng As Range
  
  Set d = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  
  Set omzet = Workbooks.Item("Omzet").Sheets("Sheet1")
  Set Maandafsluiting = Workbooks.Item("Maandafsluiting").Sheets(1)
 
  lr = omzet.Cells(Rows.Count, 2).End(3).Row
  With omzet.Cells(1, 1).Resize(lr, 14)
    data = .Value
    .Interior.ColorIndex = xlNone
  End With
 
  For rw = LBound(data) To UBound(data)
    If data(rw, 14) <> 0 Then
      ky = data(rw, 2)
      If Not d.exists(ky) Then
        d(ky) = data(rw, 14) & "|" & rw
      End If
    End If
  Next rw
 
  lr = Maandafsluiting.Cells(Rows.Count, 2).End(3).Row
  data = Maandafsluiting.Cells(1, 1).Resize(lr, 6).Formula
   
  For rw = LBound(data) To UBound(data)
    ky = data(rw, 2)
    d2(ky) = Empty
    If d.exists(ky) Then
      data(rw, 6) = Split(d(ky), "|")(0)
    End If
  Next rw

  For Each ky In d.keys
    If Not d2.exists(ky) Then
      rw = Split(d(ky), "|")(1)
      If rng Is Nothing Then
        Set rng = omzet.Cells(rw, 2)
      Else
        Set rng = Union(rng, omzet.Cells(rw, 2))
      End If
    End If
  Next
  
  If Not rng Is Nothing Then rng.Interior.Color = vbRed
  Maandafsluiting.Cells(1, 6).Resize(UBound(data)).Formula = Application.Index(data, 0, 6)
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,214,944
Messages
6,122,391
Members
449,080
Latest member
Armadillos

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top