macro corrections

T

Tonyk1051

Board Regular
Joined
Feb 1, 2021
Messages
132
Office Version
  1. 2019
Platform
  1. Windows
in tab 1 named (Not on a Category) column D (Vendors) is a list of random vendors. In tab 3 named (Vendor Policies) column A is a list of every vendor. Any vendors in the Not on a Category tab that matches the vendors in the Vendor Policy and has a yes in column J Write TT in column H of the Not on a Category Tab....macro bombs out everytime i run it...

[/code]
Sub testing()
Dim ws1 As Worksheet, ws3 As Worksheet
Dim lastRow1 As Long, lastRow3 As Long
Dim i As Long, j As Long

Set ws1 = ThisWorkbook.Sheets("Not on a Category")
Set ws3 = ThisWorkbook.Sheets("Vendor Policies")

lastRow1 = ws1.Cells(ws1.Rows.Count, "D").End(xlUp).Row
lastRow3 = ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row

For i = 2 To lastRow1
For j = 2 To lastRow3
If ws1.Cells(i, "D").Value = ws3.Cells(j, "A").Value And ws3.Cells(j, "J").Value = "yes" Then
ws1.Cells(i, "H").Value = "TT"
Exit For
End If
Next j
Next i
End Sub
[/code]

heres the link to test

www.dropbox.com

Repair Items67576.xlsm

Shared with Dropbox
www.dropbox.com www.dropbox.com
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Sort by date Sort by votes
Hi Tony,

maybe change the procedure to use AutoFilter on both sheets instead of looping though the entire ranges:

VBA Code: 
Public Sub MrE_1227851_1701809()
' https://www.mrexcel.com/board/threads/macro-corrections.1227851/
Dim lngCellsVis As Long
Dim rngHelp As Range
Dim rngCell As Range
Dim wsVenPol As Worksheet
Dim wsNotCat As Worksheet

Set wsNotCat = ThisWorkbook.Worksheets("Not on a Category")
Set wsVenPol = ThisWorkbook.Worksheets("Vendor Policies")

With wsVenPol
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1").CurrentRegion.AutoFilter Field:=10, Criteria1:="<>"
  If WorksheetFunction.CountIf(.Range("J:J"), "Yes") > 0 Then
    Set rngHelp = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible)
  End If
  .ShowAllData
End With

If Not rngHelp Is Nothing Then
  With wsNotCat
    If .AutoFilterMode Then .AutoFilterMode = False
    For Each rngCell In rngHelp
      .Range("A1").CurrentRegion.AutoFilter Field:=4, Criteria1:=rngCell.Value
      lngCellsVis = .Cells(.Rows.Count, "D").End(xlUp).Row
      If lngCellsVis > 1 Then
        .Range("H2:H" & lngCellsVis).SpecialCells(xlCellTypeVisible).Value = "TT"
      End If
    Next rngCell
    .ShowAllData
  End With
End If

end_here:
Set rngHelp = Nothing
Set wsVenPol = Nothing
Set wsNotCat = Nothing

End Sub

Ciao,
Holger
 
Upvote 0
Solution
Hi there

Try the below code... still takes about 10 seconds but should do the trick I think...

VBA Code: 
Sub testing()
    Dim ws1         As Worksheet, ws3 As Worksheet
    Dim lastRow1    As Long, lastRow3 As Long
    Dim i           As Long, j As Long
    Set ws1 = ThisWorkbook.Sheets("Not On a Category")
    Set ws3 = ThisWorkbook.Sheets("Vendor Policies")
    lastRow1 = ws1.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
    lastRow3 = ws1.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
    For i = 2 To lastRow1
        For j = 2 To lastRow3
            If ws1.Cells(i, "D").Value = ws3.Cells(j, "A").Value And ws3.Cells(j, "J").Value = "YES" Then
                ws1.Cells(i, "H").Value = "TT"
                Exit For
            End If
        Next j
    Next i
End Sub
 
Upvote 0
HaHoBe said:
Hi Tony,

maybe change the procedure to use AutoFilter on both sheets instead of looping though the entire ranges:

VBA Code: 
Public Sub MrE_1227851_1701809()
' https://www.mrexcel.com/board/threads/macro-corrections.1227851/
Dim lngCellsVis As Long
Dim rngHelp As Range
Dim rngCell As Range
Dim wsVenPol As Worksheet
Dim wsNotCat As Worksheet

Set wsNotCat = ThisWorkbook.Worksheets("Not on a Category")
Set wsVenPol = ThisWorkbook.Worksheets("Vendor Policies")

With wsVenPol
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1").CurrentRegion.AutoFilter Field:=10, Criteria1:="<>"
  If WorksheetFunction.CountIf(.Range("J:J"), "Yes") > 0 Then
    Set rngHelp = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible)
  End If
  .ShowAllData
End With

If Not rngHelp Is Nothing Then
  With wsNotCat
    If .AutoFilterMode Then .AutoFilterMode = False
    For Each rngCell In rngHelp
      .Range("A1").CurrentRegion.AutoFilter Field:=4, Criteria1:=rngCell.Value
      lngCellsVis = .Cells(.Rows.Count, "D").End(xlUp).Row
      If lngCellsVis > 1 Then
        .Range("H2:H" & lngCellsVis).SpecialCells(xlCellTypeVisible).Value = "TT"
      End If
    Next rngCell
    .ShowAllData
  End With
End If

end_here:
Set rngHelp = Nothing
Set wsVenPol = Nothing
Set wsNotCat = Nothing

End Sub

Ciao,
Holger
Click to expand...
This one is much faster than mine...
 
Upvote 0
HaHoBe said:
Hi Tony,

maybe change the procedure to use AutoFilter on both sheets instead of looping though the entire ranges:

VBA Code: 
Public Sub MrE_1227851_1701809()
' https://www.mrexcel.com/board/threads/macro-corrections.1227851/
Dim lngCellsVis As Long
Dim rngHelp As Range
Dim rngCell As Range
Dim wsVenPol As Worksheet
Dim wsNotCat As Worksheet

Set wsNotCat = ThisWorkbook.Worksheets("Not on a Category")
Set wsVenPol = ThisWorkbook.Worksheets("Vendor Policies")

With wsVenPol
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1").CurrentRegion.AutoFilter Field:=10, Criteria1:="<>"
  If WorksheetFunction.CountIf(.Range("J:J"), "Yes") > 0 Then
    Set rngHelp = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible)
  End If
  .ShowAllData
End With

If Not rngHelp Is Nothing Then
  With wsNotCat
    If .AutoFilterMode Then .AutoFilterMode = False
    For Each rngCell In rngHelp
      .Range("A1").CurrentRegion.AutoFilter Field:=4, Criteria1:=rngCell.Value
      lngCellsVis = .Cells(.Rows.Count, "D").End(xlUp).Row
      If lngCellsVis > 1 Then
        .Range("H2:H" & lngCellsVis).SpecialCells(xlCellTypeVisible).Value = "TT"
      End If
    Next rngCell
    .ShowAllData
  End With
End If

end_here:
Set rngHelp = Nothing
Set wsVenPol = Nothing
Set wsNotCat = Nothing

End Sub

Ciao,
Holger
Click to expand...

HaHoBe said:
Hi Tony,

maybe change the procedure to use AutoFilter on both sheets instead of looping though the entire ranges:

VBA Code: 
Public Sub MrE_1227851_1701809()
' https://www.mrexcel.com/board/threads/macro-corrections.1227851/
Dim lngCellsVis As Long
Dim rngHelp As Range
Dim rngCell As Range
Dim wsVenPol As Worksheet
Dim wsNotCat As Worksheet

Set wsNotCat = ThisWorkbook.Worksheets("Not on a Category")
Set wsVenPol = ThisWorkbook.Worksheets("Vendor Policies")

With wsVenPol
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1").CurrentRegion.AutoFilter Field:=10, Criteria1:="<>"
  If WorksheetFunction.CountIf(.Range("J:J"), "Yes") > 0 Then
    Set rngHelp = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible)
  End If
  .ShowAllData
End With

If Not rngHelp Is Nothing Then
  With wsNotCat
    If .AutoFilterMode Then .AutoFilterMode = False
    For Each rngCell In rngHelp
      .Range("A1").CurrentRegion.AutoFilter Field:=4, Criteria1:=rngCell.Value
      lngCellsVis = .Cells(.Rows.Count, "D").End(xlUp).Row
      If lngCellsVis > 1 Then
        .Range("H2:H" & lngCellsVis).SpecialCells(xlCellTypeVisible).Value = "TT"
      End If
    Next rngCell
    .ShowAllData
  End With
End If

end_here:
Set rngHelp = Nothing
Set wsVenPol = Nothing
Set wsNotCat = Nothing

End Sub

Ciao,
Holger
Click to expand...
thank you
 
Upvote 0
HaHoBe said:
Hi Tony,

maybe change the procedure to use AutoFilter on both sheets instead of looping though the entire ranges:

VBA Code: 
Public Sub MrE_1227851_1701809()
' https://www.mrexcel.com/board/threads/macro-corrections.1227851/
Dim lngCellsVis As Long
Dim rngHelp As Range
Dim rngCell As Range
Dim wsVenPol As Worksheet
Dim wsNotCat As Worksheet

Set wsNotCat = ThisWorkbook.Worksheets("Not on a Category")
Set wsVenPol = ThisWorkbook.Worksheets("Vendor Policies")

With wsVenPol
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1").CurrentRegion.AutoFilter Field:=10, Criteria1:="<>"
  If WorksheetFunction.CountIf(.Range("J:J"), "Yes") > 0 Then
    Set rngHelp = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible)
  End If
  .ShowAllData
End With

If Not rngHelp Is Nothing Then
  With wsNotCat
    If .AutoFilterMode Then .AutoFilterMode = False
    For Each rngCell In rngHelp
      .Range("A1").CurrentRegion.AutoFilter Field:=4, Criteria1:=rngCell.Value
      lngCellsVis = .Cells(.Rows.Count, "D").End(xlUp).Row
      If lngCellsVis > 1 Then
        .Range("H2:H" & lngCellsVis).SpecialCells(xlCellTypeVisible).Value = "TT"
      End If
    Next rngCell
    .ShowAllData
  End With
End If

end_here:
Set rngHelp = Nothing
Set wsVenPol = Nothing
Set wsNotCat = Nothing

End Sub

Ciao,
Holger
Click to expand...
Quick question as I don’t want make another thread. What would the code look like if the instructions were this.

in tab 1 named (Not on a Category) column D (Vendors) is a list of random vendors. In tab 3 named (Vendor Policies) column A is a list of every vendor. Any vendors in the Not on a Category tab that matches the vendors in the Vendor Policy and has a No in column M Write TT in column H of the Not on a Category Tab ONLY if column W in tab1 has the key word “Damaged”
 
Upvote 0
Hi Tony,

this is quite a different scenario, and there is no data beyond Column U in your sample workbook.

VBA Code: 
Public Sub MrE_1227851_1701809_Update()
' https://www.mrexcel.com/board/threads/macro-corrections.1227851/
Dim lngCellsVis As Long
Dim rngCell As Range
Dim wsVenPol As Worksheet
Dim wsNotCat As Worksheet

Set wsNotCat = ThisWorkbook.Worksheets("Not on a Category")
Set wsVenPol = ThisWorkbook.Worksheets("Vendor Policies")

With wsVenPol
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1").CurrentRegion.AutoFilter Field:=13, Criteria1:="No"
''  instead of counting out the number for the column you could use
'  .Range("A1").CurrentRegion.AutoFilter Field:=Range("M1").Column, Criteria1:="No"
  .Range("a1").CurrentRegion.AutoFilter Field:=23, Criteria1:="Damaged"
  If WorksheetFunction.CountIf(.Range("M:M"), "No") > 0 Then
    For Each rngCell In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible)
      If WorksheetFunction.CountIf(wsVenPol.Columns(1), rngCell.Value) > 0 Then
        .Cells(rngCell.Row, "H").Value = "TT"
'        rngCell.Offset(0, 7).Value = "TT"  'both codelines should do the same
      End If
    Next rngCell
  End If
  .ShowAllData
End With

end_here:
Set wsVenPol = Nothing
Set wsNotCat = Nothing

End Sub

Ciao,
Holger
 
Upvote 0
HaHoBe said:
Hi Tony,

this is quite a different scenario, and there is no data beyond Column U in your sample workbook.

VBA Code: 
Public Sub MrE_1227851_1701809_Update()
' https://www.mrexcel.com/board/threads/macro-corrections.1227851/
Dim lngCellsVis As Long
Dim rngCell As Range
Dim wsVenPol As Worksheet
Dim wsNotCat As Worksheet

Set wsNotCat = ThisWorkbook.Worksheets("Not on a Category")
Set wsVenPol = ThisWorkbook.Worksheets("Vendor Policies")

With wsVenPol
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1").CurrentRegion.AutoFilter Field:=13, Criteria1:="No"
''  instead of counting out the number for the column you could use
'  .Range("A1").CurrentRegion.AutoFilter Field:=Range("M1").Column, Criteria1:="No"
  .Range("a1").CurrentRegion.AutoFilter Field:=23, Criteria1:="Damaged"
  If WorksheetFunction.CountIf(.Range("M:M"), "No") > 0 Then
    For Each rngCell In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible)
      If WorksheetFunction.CountIf(wsVenPol.Columns(1), rngCell.Value) > 0 Then
        .Cells(rngCell.Row, "H").Value = "TT"
'        rngCell.Offset(0, 7).Value = "TT"  'both codelines should do the same
      End If
    Next rngCell
  End If
  .ShowAllData
End With

end_here:
Set wsVenPol = Nothing
Set wsNotCat = Nothing

End Sub

Ciao,
Holger
Click to expand...
HaHoBe said:
Hi Tony,

this is quite a different scenario, and there is no data beyond Column U in your sample workbook.

VBA Code: 
Public Sub MrE_1227851_1701809_Update()
' https://www.mrexcel.com/board/threads/macro-corrections.1227851/
Dim lngCellsVis As Long
Dim rngCell As Range
Dim wsVenPol As Worksheet
Dim wsNotCat As Worksheet

Set wsNotCat = ThisWorkbook.Worksheets("Not on a Category")
Set wsVenPol = ThisWorkbook.Worksheets("Vendor Policies")

With wsVenPol
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1").CurrentRegion.AutoFilter Field:=13, Criteria1:="No"
''  instead of counting out the number for the column you could use
'  .Range("A1").CurrentRegion.AutoFilter Field:=Range("M1").Column, Criteria1:="No"
  .Range("a1").CurrentRegion.AutoFilter Field:=23, Criteria1:="Damaged"
  If WorksheetFunction.CountIf(.Range("M:M"), "No") > 0 Then
    For Each rngCell In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible)
      If WorksheetFunction.CountIf(wsVenPol.Columns(1), rngCell.Value) > 0 Then
        .Cells(rngCell.Row, "H").Value = "TT"
'        rngCell.Offset(0, 7).Value = "TT"  'both codelines should do the same
      End If
    Next rngCell
  End If
  .ShowAllData
End With

end_here:
Set wsVenPol = Nothing
Set wsNotCat = Nothing

End Sub

Ciao,
Click to expand...
 
Upvote 0
HaHoBe said:
Hi Tony,

this is quite a different scenario, and there is no data beyond Column U in your sample workbook.

VBA Code: 
Public Sub MrE_1227851_1701809_Update()
' https://www.mrexcel.com/board/threads/macro-corrections.1227851/
Dim lngCellsVis As Long
Dim rngCell As Range
Dim wsVenPol As Worksheet
Dim wsNotCat As Worksheet

Set wsNotCat = ThisWorkbook.Worksheets("Not on a Category")
Set wsVenPol = ThisWorkbook.Worksheets("Vendor Policies")

With wsVenPol
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1").CurrentRegion.AutoFilter Field:=13, Criteria1:="No"
''  instead of counting out the number for the column you could use
'  .Range("A1").CurrentRegion.AutoFilter Field:=Range("M1").Column, Criteria1:="No"
  .Range("a1").CurrentRegion.AutoFilter Field:=23, Criteria1:="Damaged"
  If WorksheetFunction.CountIf(.Range("M:M"), "No") > 0 Then
    For Each rngCell In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible)
      If WorksheetFunction.CountIf(wsVenPol.Columns(1), rngCell.Value) > 0 Then
        .Cells(rngCell.Row, "H").Value = "TT"
'        rngCell.Offset(0, 7).Value = "TT"  'both codelines should do the same
      End If
    Next rngCell
  End If
  .ShowAllData
End With

end_here:
Set wsVenPol = Nothing
Set wsNotCat = Nothing

End Sub

Ciao,
Holger
Click to expand...
dmg.xlsm.

Here is the link, I modified it so all 82 lines in tab 1will have TT in column H when done manually since all those vendors have a no in vendor policy tab and have “Damaged” in Coulmn W of tab 1.Your macro didn’t work but I think it’s just a miscommunication between you and I
 
Upvote 0
Hi Tony,

I understood your request to have both conditions on the same sheet so the code could not do what you wanted it to do.

In order to make the code work you need to take care that each cell of the headings in Not on a Category is filled (at least with a blank). If you run the procedure without doing so a Runtime Error 1004 will be raised.

The altered code looks like this:

VBA Code: 
Public Sub MrE_1227851Update()
' https://www.mrexcel.com/board/threads/macro-corrections.1227851/
Dim rngCell As Range
Dim rngTT As Range
Dim wsVenPol As Worksheet
Dim wsNotCat As Worksheet

Set wsNotCat = ThisWorkbook.Worksheets("Not on a Category")
Set wsVenPol = ThisWorkbook.Worksheets("Vendor Policies")

With wsVenPol
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1").CurrentRegion.AutoFilter Field:=13, Criteria1:="No"
  If WorksheetFunction.CountIf(.Range("M:M"), "No") > 0 Then
    For Each rngCell In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible)
      With wsNotCat
        If .AutoFilterMode Then .AutoFilterMode = False
        .Range("A1").CurrentRegion.AutoFilter Field:=23, Criteria1:="Damaged"
        .Range("A1").CurrentRegion.AutoFilter Field:=4, Criteria1:=rngCell.Value
        If .Cells(.Rows.Count, "D").End(xlUp).Row > 1 Then
          For Each rngTT In Intersect(wsNotCat.UsedRange, wsNotCat.Columns(4).SpecialCells(xlCellTypeVisible))
            If rngTT.Row > 1 Then rngTT.Offset(0, 4).Value = "TT"
          Next rngTT
        End If
      End With
    Next rngCell
  End If
  If wsNotCat.AutoFilterMode Then wsNotCat.AutoFilterMode = False
  .ShowAllData
End With

end_here:
Set wsVenPol = Nothing
Set wsNotCat = Nothing

End Sub

Ciao,
Holger
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Tweak Macro that Imports specific table columns from a different workbook to filter a column first
Replies
4
Views
162
sspatriots
S
B
  • Question
Comparing two sheets for differences in rows and copy to different sheet
Replies
3
Views
708
Brutusar
B
P
  • Question
Code used for comparison between 2 list.
Replies
3
Views
306
Tupe77
T
S
  • Solved
Import csv file and append to existing table?
Replies
5
Views
609
shellp
S
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
1
Views
204
bobaol
B

Forum statistics

Threads
1,214,832
Messages
6,121,849
Members
449,051
Latest member
excelquestion515

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