need a return value macro

T

Tonyk1051

Board Regular
Joined
Feb 1, 2021
Messages
132
Office Version
  1. 2019
Platform
  1. Windows
for TT.xlsm heres a link to the tester file

(real file will have differnt amount of lines anywhere from 50- 5000. tab names and headers will always be the same)

In Not on a Category tab, column D will have random vendor names, its different every day.
Vendor Policy tab column has every single vendor in column A
If any vendors in Not a Category tab match with column A in Vendor Policy tab then check if there is a yes in column J of vendor policy tab. If its yes then put in column H of Not a Category tab TT

so example tab1 column D has 1 source video.
tab3 has 1 source video also and column J is yes so i manually put TT in coulmn H not a category tab

thanks in the advance for the macro
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Sort by date Sort by votes
Use formula in cell H2 then drag down:
Code: 
=IF(VLOOKUP(D2,'Vendor Policies'!$A$2:$J$3721,10)="Yes","TT","")
 
Upvote 0
bebo021999 said:
Use formula in cell H2 then drag down:
Code: 
=IF(VLOOKUP(D2,'Vendor Policies'!$A$2:$J$3721,10)="Yes","TT","")
Click to expand...
It works kinda…2 issues. I pasted the formula in cell h2 of tab 1 and dragged it down. For some reason h2 didn’t populate with TT as that vendor on line 2 is a yes. Also when I try to sort the spreadsheet by column H to bring all the TT to the top, it doesn’t work
 
Upvote 0
May be using COUNTIFS to test
Code: 
=IF(COUNTIFS('Vendor Policies'!$A$2:$A$3721,D2,'Vendor Policies'!$J$2:$J$3721,"YES"),"TT","")
 
Upvote 0
I don't understand that seems to be an identical question to your previous question in the link below with less criteria than you finised up with in that thread.
macro corrections
It doesn't make sense to answer 1 criteria at a time. What are you trying to achieve ?
 
Last edited:
Upvote 0
In that thread I found a solution to one and it got more confusing once I changed the rules.
What I should have done was just create a new post. If i could delete the old thread one I would but I don’t know how…
 
Upvote 0
Give this a try on a copy of your workbook.
Ideally I shouldn't load in all the columns but I wanted it to be ready if you had more criteria.
Note: You have 13 duplicate vendors on your Policies sheet and this could cause errors and should be addressed.

VBA Code: 
Sub UpdateTT()

    Dim wsVenPol As Worksheet, wsNotCat As Worksheet
    Dim rngVenPol As Range, rngNotCat As Range
    Dim lrowVenPol As Long, lrowNotCat As Long
    Dim lcolVenPol As Long, lcolNotCat As Long
    Dim arrVenPol As Variant, arrNotCat As Variant
    Dim i As Long, idxVen As Long
    Dim dictVenPol As Object, dictKey As String
    
    Set wsVenPol = ActiveWorkbook.Worksheets("Vendor Policies")
    Set wsNotCat = ActiveWorkbook.Worksheets("Not on a Category")
    
    With wsVenPol
        lrowVenPol = .Cells(Rows.Count, "A").End(xlUp).Row
        lcolVenPol = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rngVenPol = .Range(.Cells(2, "A"), .Cells(lrowVenPol, lcolVenPol))
        arrVenPol = rngVenPol.Value2
    End With
    
    With wsNotCat
        lrowNotCat = .Cells(Rows.Count, "A").End(xlUp).Row
        lcolNotCat = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rngNotCat = .Range(.Cells(2, "A"), .Cells(lrowNotCat, lcolNotCat))
        arrNotCat = rngNotCat.Value2
    End With
 
    ' Load Vendor Policies into Dictionary
    Set dictVenPol = CreateObject("Scripting.dictionary")
    For i = 1 To UBound(arrVenPol)
        dictKey = arrVenPol(i, 1)
        If Not dictVenPol.exists(dictKey) Then
            dictVenPol(dictKey) = i
        End If
    Next i

    ' Lookup Dictionary and Update column H in "Not on a Category Sheet" if Ven Column J = YES
    For i = 1 To UBound(arrNotCat)
        dictKey = arrNotCat(i, 4)
        If dictVenPol.exists(dictKey) Then
            idxVen = dictVenPol(dictKey)
            If UCase(arrVenPol(idxVen, 10)) = "YES" Then        ' Col J
                arrNotCat(i, 8) = "TT"                          ' Col H
            End If
        End If
    Next i

    ' Output updated column 8
    rngNotCat.Columns(8).Value2 = Application.Index(arrNotCat, 0, 8)

End Sub

Duplicate Vendors on Policies sheet
Book5
A
1Vendor Desc
2ADESSO INC.
3GURA GEAR, LLC
4H&Y USA LLC
5HEARTLAND CUSTOMER SOLUTIONS,
6MAXELL CORPORATION OF AMERICA
7OLLOCLIP
8SAMSUNG MOBILE
9SCANSOURCE, INC.
10SENNHEISER ELECTRONIC CORP.
11TELEDYNE FLIR COMMERCIAL SYSTE
12VIDENDUM PRODUCTION SOLUTIONS
13YUNEEC USA
14ZERO ZERO ROBOTICS INC.
Sheet1
 
Upvote 0
Solution
Alex Blakenburg said:
Give this a try on a copy of your workbook.
Ideally I shouldn't load in all the columns but I wanted it to be ready if you had more criteria.
Note: You have 13 duplicate vendors on your Policies sheet and this could cause errors and should be addressed.

VBA Code: 
Sub UpdateTT()

    Dim wsVenPol As Worksheet, wsNotCat As Worksheet
    Dim rngVenPol As Range, rngNotCat As Range
    Dim lrowVenPol As Long, lrowNotCat As Long
    Dim lcolVenPol As Long, lcolNotCat As Long
    Dim arrVenPol As Variant, arrNotCat As Variant
    Dim i As Long, idxVen As Long
    Dim dictVenPol As Object, dictKey As String
  
    Set wsVenPol = ActiveWorkbook.Worksheets("Vendor Policies")
    Set wsNotCat = ActiveWorkbook.Worksheets("Not on a Category")
  
    With wsVenPol
        lrowVenPol = .Cells(Rows.Count, "A").End(xlUp).Row
        lcolVenPol = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rngVenPol = .Range(.Cells(2, "A"), .Cells(lrowVenPol, lcolVenPol))
        arrVenPol = rngVenPol.Value2
    End With
  
    With wsNotCat
        lrowNotCat = .Cells(Rows.Count, "A").End(xlUp).Row
        lcolNotCat = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rngNotCat = .Range(.Cells(2, "A"), .Cells(lrowNotCat, lcolNotCat))
        arrNotCat = rngNotCat.Value2
    End With
 
    ' Load Vendor Policies into Dictionary
    Set dictVenPol = CreateObject("Scripting.dictionary")
    For i = 1 To UBound(arrVenPol)
        dictKey = arrVenPol(i, 1)
        If Not dictVenPol.exists(dictKey) Then
            dictVenPol(dictKey) = i
        End If
    Next i

    ' Lookup Dictionary and Update column H in "Not on a Category Sheet" if Ven Column J = YES
    For i = 1 To UBound(arrNotCat)
        dictKey = arrNotCat(i, 4)
        If dictVenPol.exists(dictKey) Then
            idxVen = dictVenPol(dictKey)
            If UCase(arrVenPol(idxVen, 10)) = "YES" Then        ' Col J
                arrNotCat(i, 8) = "TT"                          ' Col H
            End If
        End If
    Next i

    ' Output updated column 8
    rngNotCat.Columns(8).Value2 = Application.Index(arrNotCat, 0, 8)

End Sub

Duplicate Vendors on Policies sheet
Book5
A
1Vendor Desc
2ADESSO INC.
3GURA GEAR, LLC
4H&Y USA LLC
5HEARTLAND CUSTOMER SOLUTIONS,
6MAXELL CORPORATION OF AMERICA
7OLLOCLIP
8SAMSUNG MOBILE
9SCANSOURCE, INC.
10SENNHEISER ELECTRONIC CORP.
11TELEDYNE FLIR COMMERCIAL SYSTE
12VIDENDUM PRODUCTION SOLUTIONS
13YUNEEC USA
14ZERO ZERO ROBOTICS INC.
Sheet1
Click to expand...
Alex Blakenburg said:
Give this a try on a copy of your workbook.
Ideally I shouldn't load in all the columns but I wanted it to be ready if you had more criteria.
Note: You have 13 duplicate vendors on your Policies sheet and this could cause errors and should be addressed.

VBA Code: 
Sub UpdateTT()

    Dim wsVenPol As Worksheet, wsNotCat As Worksheet
    Dim rngVenPol As Range, rngNotCat As Range
    Dim lrowVenPol As Long, lrowNotCat As Long
    Dim lcolVenPol As Long, lcolNotCat As Long
    Dim arrVenPol As Variant, arrNotCat As Variant
    Dim i As Long, idxVen As Long
    Dim dictVenPol As Object, dictKey As String
  
    Set wsVenPol = ActiveWorkbook.Worksheets("Vendor Policies")
    Set wsNotCat = ActiveWorkbook.Worksheets("Not on a Category")
  
    With wsVenPol
        lrowVenPol = .Cells(Rows.Count, "A").End(xlUp).Row
        lcolVenPol = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rngVenPol = .Range(.Cells(2, "A"), .Cells(lrowVenPol, lcolVenPol))
        arrVenPol = rngVenPol.Value2
    End With
  
    With wsNotCat
        lrowNotCat = .Cells(Rows.Count, "A").End(xlUp).Row
        lcolNotCat = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rngNotCat = .Range(.Cells(2, "A"), .Cells(lrowNotCat, lcolNotCat))
        arrNotCat = rngNotCat.Value2
    End With
 
    ' Load Vendor Policies into Dictionary
    Set dictVenPol = CreateObject("Scripting.dictionary")
    For i = 1 To UBound(arrVenPol)
        dictKey = arrVenPol(i, 1)
        If Not dictVenPol.exists(dictKey) Then
            dictVenPol(dictKey) = i
        End If
    Next i

    ' Lookup Dictionary and Update column H in "Not on a Category Sheet" if Ven Column J = YES
    For i = 1 To UBound(arrNotCat)
        dictKey = arrNotCat(i, 4)
        If dictVenPol.exists(dictKey) Then
            idxVen = dictVenPol(dictKey)
            If UCase(arrVenPol(idxVen, 10)) = "YES" Then        ' Col J
                arrNotCat(i, 8) = "TT"                          ' Col H
            End If
        End If
    Next i

    ' Output updated column 8
    rngNotCat.Columns(8).Value2 = Application.Index(arrNotCat, 0, 8)

End Sub

Duplicate Vendors on Policies sheet
Book5
A
1Vendor Desc
2ADESSO INC.
3GURA GEAR, LLC
4H&Y USA LLC
5HEARTLAND CUSTOMER SOLUTIONS,
6MAXELL CORPORATION OF AMERICA
7OLLOCLIP
8SAMSUNG MOBILE
9SCANSOURCE, INC.
10SENNHEISER ELECTRONIC CORP.
11TELEDYNE FLIR COMMERCIAL SYSTE
12VIDENDUM PRODUCTION SOLUTIONS
13YUNEEC USA
14ZERO ZERO ROBOTICS INC.
Sheet1

Alex Blakenburg said:
Give this a try on a copy of your workbook.
Ideally I shouldn't load in all the columns but I wanted it to be ready if you had more criteria.
Note: You have 13 duplicate vendors on your Policies sheet and this could cause errors and should be addressed.

VBA Code: 
Sub UpdateTT()

    Dim wsVenPol As Worksheet, wsNotCat As Worksheet
    Dim rngVenPol As Range, rngNotCat As Range
    Dim lrowVenPol As Long, lrowNotCat As Long
    Dim lcolVenPol As Long, lcolNotCat As Long
    Dim arrVenPol As Variant, arrNotCat As Variant
    Dim i As Long, idxVen As Long
    Dim dictVenPol As Object, dictKey As String
  
    Set wsVenPol = ActiveWorkbook.Worksheets("Vendor Policies")
    Set wsNotCat = ActiveWorkbook.Worksheets("Not on a Category")
  
    With wsVenPol
        lrowVenPol = .Cells(Rows.Count, "A").End(xlUp).Row
        lcolVenPol = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rngVenPol = .Range(.Cells(2, "A"), .Cells(lrowVenPol, lcolVenPol))
        arrVenPol = rngVenPol.Value2
    End With
  
    With wsNotCat
        lrowNotCat = .Cells(Rows.Count, "A").End(xlUp).Row
        lcolNotCat = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rngNotCat = .Range(.Cells(2, "A"), .Cells(lrowNotCat, lcolNotCat))
        arrNotCat = rngNotCat.Value2
    End With
 
    ' Load Vendor Policies into Dictionary
    Set dictVenPol = CreateObject("Scripting.dictionary")
    For i = 1 To UBound(arrVenPol)
        dictKey = arrVenPol(i, 1)
        If Not dictVenPol.exists(dictKey) Then
            dictVenPol(dictKey) = i
        End If
    Next i

    ' Lookup Dictionary and Update column H in "Not on a Category Sheet" if Ven Column J = YES
    For i = 1 To UBound(arrNotCat)
        dictKey = arrNotCat(i, 4)
        If dictVenPol.exists(dictKey) Then
            idxVen = dictVenPol(dictKey)
            If UCase(arrVenPol(idxVen, 10)) = "YES" Then        ' Col J
                arrNotCat(i, 8) = "TT"                          ' Col H
            End If
        End If
    Next i

    ' Output updated column 8
    rngNotCat.Columns(8).Value2 = Application.Index(arrNotCat, 0, 8)

End Sub

Duplicate Vendors on Policies sheet
Book5
A
1Vendor Desc
2ADESSO INC.
3GURA GEAR, LLC
4H&Y USA LLC
5HEARTLAND CUSTOMER SOLUTIONS,
6MAXELL CORPORATION OF AMERICA
7OLLOCLIP
8SAMSUNG MOBILE
9SCANSOURCE, INC.
10SENNHEISER ELECTRONIC CORP.
11TELEDYNE FLIR COMMERCIAL SYSTE
12VIDENDUM PRODUCTION SOLUTIONS
13YUNEEC USA
14ZERO ZERO ROBOTICS INC.
Sheet1
Click to expand...
So long as I delete the duplicates before running your code it should work fine no?
Click to expand...
Alex Blakenburg said:
Give this a try on a copy of your workbook.
Ideally I shouldn't load in all the columns but I wanted it to be ready if you had more criteria.
Note: You have 13 duplicate vendors on your Policies sheet and this could cause errors and should be addressed.

VBA Code: 
Sub UpdateTT()

    Dim wsVenPol As Worksheet, wsNotCat As Worksheet
    Dim rngVenPol As Range, rngNotCat As Range
    Dim lrowVenPol As Long, lrowNotCat As Long
    Dim lcolVenPol As Long, lcolNotCat As Long
    Dim arrVenPol As Variant, arrNotCat As Variant
    Dim i As Long, idxVen As Long
    Dim dictVenPol As Object, dictKey As String
   
    Set wsVenPol = ActiveWorkbook.Worksheets("Vendor Policies")
    Set wsNotCat = ActiveWorkbook.Worksheets("Not on a Category")
   
    With wsVenPol
        lrowVenPol = .Cells(Rows.Count, "A").End(xlUp).Row
        lcolVenPol = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rngVenPol = .Range(.Cells(2, "A"), .Cells(lrowVenPol, lcolVenPol))
        arrVenPol = rngVenPol.Value2
    End With
   
    With wsNotCat
        lrowNotCat = .Cells(Rows.Count, "A").End(xlUp).Row
        lcolNotCat = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rngNotCat = .Range(.Cells(2, "A"), .Cells(lrowNotCat, lcolNotCat))
        arrNotCat = rngNotCat.Value2
    End With
 
    ' Load Vendor Policies into Dictionary
    Set dictVenPol = CreateObject("Scripting.dictionary")
    For i = 1 To UBound(arrVenPol)
        dictKey = arrVenPol(i, 1)
        If Not dictVenPol.exists(dictKey) Then
            dictVenPol(dictKey) = i
        End If
    Next i

    ' Lookup Dictionary and Update column H in "Not on a Category Sheet" if Ven Column J = YES
    For i = 1 To UBound(arrNotCat)
        dictKey = arrNotCat(i, 4)
        If dictVenPol.exists(dictKey) Then
            idxVen = dictVenPol(dictKey)
            If UCase(arrVenPol(idxVen, 10)) = "YES" Then        ' Col J
                arrNotCat(i, 8) = "TT"                          ' Col H
            End If
        End If
    Next i

    ' Output updated column 8
    rngNotCat.Columns(8).Value2 = Application.Index(arrNotCat, 0, 8)

End Sub

Duplicate Vendors on Policies sheet
Book5
A
1Vendor Desc
2ADESSO INC.
3GURA GEAR, LLC
4H&Y USA LLC
5HEARTLAND CUSTOMER SOLUTIONS,
6MAXELL CORPORATION OF AMERICA
7OLLOCLIP
8SAMSUNG MOBILE
9SCANSOURCE, INC.
10SENNHEISER ELECTRONIC CORP.
11TELEDYNE FLIR COMMERCIAL SYSTE
12VIDENDUM PRODUCTION SOLUTIONS
13YUNEEC USA
14ZERO ZERO ROBOTICS INC.
Sheet1
Click to expand...
So long as I delete the duplicates before running, I should be fine no? I ll try it and let you know
 
Upvote 0
Correct. The duplicates won't cause the macro to fail but the macro will only look at the first entry which is fine if they both say YES or are both blank.
 
Upvote 0
Alex Blakenburg said:
Give this a try on a copy of your workbook.
Ideally I shouldn't load in all the columns but I wanted it to be ready if you had more criteria.
Note: You have 13 duplicate vendors on your Policies sheet and this could cause errors and should be addressed.

VBA Code: 
Sub UpdateTT()

    Dim wsVenPol As Worksheet, wsNotCat As Worksheet
    Dim rngVenPol As Range, rngNotCat As Range
    Dim lrowVenPol As Long, lrowNotCat As Long
    Dim lcolVenPol As Long, lcolNotCat As Long
    Dim arrVenPol As Variant, arrNotCat As Variant
    Dim i As Long, idxVen As Long
    Dim dictVenPol As Object, dictKey As String
   
    Set wsVenPol = ActiveWorkbook.Worksheets("Vendor Policies")
    Set wsNotCat = ActiveWorkbook.Worksheets("Not on a Category")
   
    With wsVenPol
        lrowVenPol = .Cells(Rows.Count, "A").End(xlUp).Row
        lcolVenPol = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rngVenPol = .Range(.Cells(2, "A"), .Cells(lrowVenPol, lcolVenPol))
        arrVenPol = rngVenPol.Value2
    End With
   
    With wsNotCat
        lrowNotCat = .Cells(Rows.Count, "A").End(xlUp).Row
        lcolNotCat = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rngNotCat = .Range(.Cells(2, "A"), .Cells(lrowNotCat, lcolNotCat))
        arrNotCat = rngNotCat.Value2
    End With
 
    ' Load Vendor Policies into Dictionary
    Set dictVenPol = CreateObject("Scripting.dictionary")
    For i = 1 To UBound(arrVenPol)
        dictKey = arrVenPol(i, 1)
        If Not dictVenPol.exists(dictKey) Then
            dictVenPol(dictKey) = i
        End If
    Next i

    ' Lookup Dictionary and Update column H in "Not on a Category Sheet" if Ven Column J = YES
    For i = 1 To UBound(arrNotCat)
        dictKey = arrNotCat(i, 4)
        If dictVenPol.exists(dictKey) Then
            idxVen = dictVenPol(dictKey)
            If UCase(arrVenPol(idxVen, 10)) = "YES" Then        ' Col J
                arrNotCat(i, 8) = "TT"                          ' Col H
            End If
        End If
    Next i

    ' Output updated column 8
    rngNotCat.Columns(8).Value2 = Application.Index(arrNotCat, 0, 8)

End Sub

Duplicate Vendors on Policies sheet
Book5
A
1Vendor Desc
2ADESSO INC.
3GURA GEAR, LLC
4H&Y USA LLC
5HEARTLAND CUSTOMER SOLUTIONS,
6MAXELL CORPORATION OF AMERICA
7OLLOCLIP
8SAMSUNG MOBILE
9SCANSOURCE, INC.
10SENNHEISER ELECTRONIC CORP.
11TELEDYNE FLIR COMMERCIAL SYSTE
12VIDENDUM PRODUCTION SOLUTIONS
13YUNEEC USA
14ZERO ZERO ROBOTICS INC.
Sheet1
Click to expand...
worked like a charm, thanks alex
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
macro corrections
2
Replies
13
Views
608
HaHoBe
HaHoBe
N
  • Question
Index Match after sorting
Replies
1
Views
272
Eric W
Eric W
B
  • Solved
vba code to give next Sunday date for pasted data
Replies
2
Views
184
bh24524
B
F
  • Solved
Copying and pasting onto mastersheet but files have different formats (need if statement help)
2
Replies
12
Views
904
NateSC
NateSC
B
  • Solved
Run macro when drop-down value changes
Replies
3
Views
790
Joe4
Joe4

Forum statistics

Threads
1,214,897
Messages
6,122,141
Members
449,066
Latest member
Andyg666

Share this page

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