VBA - If Question

[ExcelMercy]

Hey everyone,

I have a question about setting up an IF (or some other conditional code) around my macro to make sure certain things are found FIRST before running.

The issue I'm getting is I need to ensure that SystemCode = Array("AP_123_Lo_4", "AP_123_Lo_6", "JF_123_Lo_1_SYS", "JF_123_Lo_2", "HG_123_Lo_2_SYS") is present. If one of them is, then go ahead and run the macro. If none are present, I want to skip the entire thing and not do any of it.




Here is all the info (code, sample data):

Sub Market_Confirm_Test()
    
    Dim ws11       As Worksheet
    Dim ws12       As Worksheet
    Dim x          As Long
    Dim y          As Long
    Dim SystemCode As Variant
    
    Application.ScreenUpdating = False

    Set ws11 = ThisWorkbook.Worksheets("Market_Totals")
    Set ws12 = Worksheets.Add
    
    SystemCode = Array("AP_123_Lo_4", "AP_123_Lo_6", "JF_123_Lo_1_SYS", "JF_123_Lo_2", "HG_123_Lo_2_SYS")
    
    With ws12
        .Name = "Market_Confirm"
        .Move after:=Sheets(Sheets.Count)
        .Range("A1").Resize(1, 7).Value = Array("System Code", "First Name", "Last Name", "Address 1", "City", "State", "Market ID")
    End With
    
    With ws11
        If .AutoFilterMode Then .AutoFilterMode = False
        x = .Range("D" & .Rows.Count).End(xlUp).Row
        y = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1

         .Cells(1, "D").Resize(x).AutoFilter Field:=1, Criteria1:=SystemCode, Operator:=xlFilterValues
        If .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
            .Range("D2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
            ws12.Range("A2").PasteSpecial xlPasteAll
            .Range("F2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
            ws12.Range("B2").PasteSpecial xlPasteAll
            .Range("H2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
            ws12.Range("C2").PasteSpecial xlPasteAll
            .Range("I2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
            ws12.Range("D2").PasteSpecial xlPasteAll
            .Range("K2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
            ws12.Range("E2").PasteSpecial xlPasteAll
            .Range("L2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
            ws12.Range("F2").PasteSpecial xlPasteAll
            .Range("B2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
            ws12.Range("G2").PasteSpecial xlPasteAll
        End If
    End With
    
    Application.ScreenUpdating = True
    Set ws11 = Nothing
    Set ws12 = Nothing

End Sub

Starting Sheet (Market_Totals)

Type

Market ID

Order by

System Code

Name id

First Name

Middle Initial

Last Name

Address 1

Address 2

City

State

Postal code

1

213546

*

AP_123_Lo_4

75473d

Billy

C

Smith

111 N Street

Philadelphia

PA

12345

1

432452

*

AP_123_Lo_5

756859d

Jacob

Johnson

123 S Street

New Orleans

LA

84001

1

3425267

*

AP_123_Lo_6

7646d

Sue

Doe

123 Main St

Atlanta

GA

65431

1

8798567

*

AP_123_Lo_7

435322fg

Becky

A

Smith

123 NorthWest Main Rd

Nashville

TN

45678

2

679732542

*

AP_123_Lo_8

4325253fg

Stacy

Marshall

9483 Walkway Dr

Houston

TX

54634

2

3242368

*

JF_123_Lo_1_SYS

23215fg

Larence

S

Donald

2143 Systems Avn

New Orleans

LA

84001

1

6775674

*

JF_123_Lo_2

64345d

Kimberly

Jones

123 Timber Rd

Nashville

TN

54001

1

53424567

*

JF_123_Lo_2

6788900d

Mike

G

Gareld

136 South rd

Philadelphia

PA

45201

1

8798567

*

HG_123_Lo_1_SYS

6422fg

Becky

A

Smith

788 Landing Rd

Nashville

TN

45678

2

679732542

*

HG_123_Lo_1_SYS

6233fg

Stacy

Marshall

3 Moore Dr

Philadelphia

PA

85201

2

3242368

*

HG_123_Lo_1_SYS

5234fg

Larence

S

Donald

212 Lake Drive

Philadelphia

PA

95201

1

6775674

*

HG_123_Lo_2_SYS

3125d

Kimberly

Jones

1677 Trees Rd

New Orleans

LA

84001

1

53424567

*

HG_123_Lo_2_SYS

432656d

Mike

G

Gareld

13455 Northsouth Rd

Philadelphia

PA

65201

<tbody>
</tbody>

Output:

System Code	First Name	Last Name	Address 1	City	State	Market ID
AP_123_Lo_4	Billy	Smith	111 N Street	Philadelphia	PA	213546
AP_123_Lo_6	Jacob	Johnson	123 S Street	New Orleans	LA	432452
JF_123_Lo_1_SYS	Larence	Donald	2143 Systems Avn	New Orleans	LA	3242368
JF_123_Lo_2	Kimberly	Jones	123 Timber Rd	Nashville	TN	6775674
HG_123_Lo_2_SYS	Kimberly	Jones	1677 Trees Rd	New Orleans	LA	6775674
HG_123_Lo_2_SYS	Mike	Gareld	13455 Northsouth Rd	Philadelphia	PA	53424567

<tbody>
</tbody>

 

[Jerry Sullivan]

Hi ExcelMercy,

Try adding a validating function to the same code module....

Function bHasMatches(rRangeToCheck As Range, vFind As Variant) As Boolean
'--checks one column range to see if any values in vFind exist
'  if found returns True, else False
'  assumes:
'   rRangeToCheck has already been validated as one column range
'   vFind has already been validated as an 1D array

 Dim bReturn As Boolean
 Dim lNdx As Long
 Dim vData As Variant
 
 With rRangeToCheck
   On Error Resume Next '--handle no intersect
   vData = Application.Transpose(Intersect(.Parent.UsedRange, .Cells).Value)
   On Error GoTo 0
 End With
 
 For lNdx = LBound(vFind) To UBound(vFind)
   If IsNumeric(Application.Match(vFind(lNdx), vData, 0)) Then
      bReturn = True
      GoTo ExitProc
   End If
 Next lNdx

ExitProc:
 bHasMatches = bReturn
End Function

Then modify the start of your sub to call that function...

Sub Market_Confirm_Test()
    
    Dim ws11       As Worksheet
    Dim ws12       As Worksheet
    Dim x          As Long
    Dim y          As Long
    Dim SystemCode As Variant
    
    Set ws11 = ThisWorkbook.Worksheets("Market_Totals")
    SystemCode = Array("AP_123_Lo_4", "AP_123_Lo_6", "JF_123_Lo_1_SYS", "JF_123_Lo_2", "HG_123_Lo_2_SYS")

    If Not bHasMatches(rRangeToCheck:=ws11.Range("D:D"), vFind:=SystemCode) Then Exit Sub
    
    Application.ScreenUpdating = False
    
    Set ws12 = Worksheets.Add