dimanche 15 mars 2020

Excel Macro to Skip multiple lines of code if no match

I have two excel files. One contains data identified as “customer information spreadsheet” and the second one (with the macro) is where a user could input data to match a consultant in the “consultants.xlsm”. The “customer information” spreadsheet contains customer/orders that need to match up to the consultant which will be open at the same time the macro is run. When the macro is run a name gets input to the “customer information” spreadsheet pulled from the consultant spreadsheet starting with the "a" column then going to the "b" column and so and so.

What I need help with is … if there is no match between customer information and consultant, then move to the next set of instructions. I have “DIM rngConsultant” up to 12 consultants but am only showing 3 below. I’m sure this is ugly code but its what I’ve gotten to work for the most part:

Sub FilterbyConsultant()

 Dim rngConsultant As Range
 With Workbooks("Consultants.xlsm").Sheets("Consultants")
 Set rngConsultant = .Range("A3", .Range("A" & Columns.Count).End(xlUp))
 End With
 Range("A1:A25000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rngConsultant, Unique:=False

Range("B1").Select
ActiveCell.FormulaR1C1 = Workbooks("Consultants.xlsm").Sheets("Consultants").Range("A1")
Range("B1").Select
Selection.Copy
Range("B12").Select
Selection.End(xlDown).Select
ActiveSheet.Paste
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.Font.Bold = False
Range("B1").Select
ActiveCell.FormulaR1C1 = "Consultant"
Range("A1").Select
ActiveSheet.ShowAllData
Selection.AutoFilter

 Dim rngConsultant2 As Range
 With Workbooks("Consultants.xlsm").Sheets("Consultants")
 Set rngConsultant2 = .Range("B3", .Range("B" & Columns.Count).End(xlUp))
 End With
 Range("A1:A25000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rngConsultant2, Unique:=False

Range("B1").Select
ActiveCell.FormulaR1C1 = Workbooks("Consultants.xlsm").Sheets("Consultants").Range("B1")
Range("B1").Select
Selection.Copy
Range("B25").Select
Selection.End(xlDown).Select
ActiveSheet.Paste
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Range("B1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Consultant"
Range("A1").Select
ActiveSheet.ShowAllData
Selection.AutoFilter


 Dim rngConsultant3 As Range
 With Workbooks("Consultants.xlsm").Sheets("Consultants")
 Set rngConsultant = .Range("C3", .Range("C" & Columns.Count).End(xlUp))
 End With
 Range("A1:A25000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rngConsultant3, Unique:=False

Range("B1").Select
ActiveCell.FormulaR1C1 = Workbooks("Consultants.xlsm").Sheets("Consultants").Range("C1")
Range("B1").Select
Selection.Copy
Range("B37").Select
Selection.End(xlDown).Select
ActiveSheet.Paste
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Range("B1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Consultant"
Range("A1").Select

Aucun commentaire:

Enregistrer un commentaire