VB problem - too many IFs? Convert to Select Case?

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Gram123

Thread Starter
Joined
Mar 15, 2001
Messages
1,829
Hi,
I'm not a big user of VB, so my knowledge of it is pretty limited. I've tried to amend a bit of macro code in Excel, to add some additional IFs, and it's falling down.

Basically, I have 17-character vehicle chassis numbers (some real, some manufactured) in column A and the code checks the cells, and returns a text value depending on the first few characters of the chassis.

Here's how the problematic bit of code looks at present:

ActiveWindow.ScrollColumn = 1
Application.Goto Reference:="R1C7"
Range("G1").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISNUMBER(FIND(""AUTFORD"",RC[-6])),""FORD00"",IF(ISNUMBER(FIND(""AUTVAUX"",RC[-6])),""VAUXHA"",IF(ISNUMBER(FIND(""VNVF1"",RC[-6])),""NISSAN"",IF(ISNUMBER(FIND(""VF1"",RC[-6])),""RENAUL"",IF(ISNUMBER(FIND(""AUTNISS"",RC[-6])),""DELETE"",IF(ISNUMBER(FIND(""AUTRCI"",RC[-6])),""DELETE"",IF(ISNUMBER(FIND(""AUTVRS"",RC[-6])),""DELETE"",IF(ISNUMBER(FIND(""AUTWES"",RC[-6])),""DELETE"",IF(ISBLANK(RC[-6]),"""",""MISC00"")))))))))"

If I remember rightly, I adopted the macro code long ago and adapted it to my needs. It's worked fine up until I started trying to include additional cases. The new bits I've added are those cases that result in DELETE. When I add just 2 of them, it seems to work, but when I add in all 4, I get a Run-Time Error '1004': Application-defined or object-defined error.

So, is this problem due to having too many IFs? I thought you could have 64 in VB?
Or is it something else?
Should I be changing this to a SELECT CASE statement, and if so, can someone show me how?


Thanks.
 

Ent

Josiah
Retired Trusted Advisor
Joined
Apr 11, 2009
Messages
5,467
I think there's a bit of a muddle here.
If you want to use select case you'll have to do it within the VBA code rather, as you have done, than setting it as the formula of the cell in question. That said I suspect you'd fare better looking at alternatives, such as using a VLookup and disposing with macros entirely.

Perhaps you could upload the file here so we can take a look.
 

Gram123

Thread Starter
Joined
Mar 15, 2001
Messages
1,829
I regularly extract data from another system. I access this data using a Crystal Report, and then export it as an Excel (data only) file.
In Excel I have a button with the macro behind it, which when clicked strips out some data and depending on the nature of the chassis number, adds in some other data in (the model codes I noted within the IF formula).

I remember now, I didn't adopt someone else's code - I recorded the macro some time back, and then modified the code a little (primarily, adding comments to help me understand what each bit of VBA was doing).

I've attached a raw data file example (i.e. exported from Crystal, but macro not yet ran).

The following is the macro code in full, in the state it was in before I tried adding the 4 new IF clauses.


Sub Prep_Fails()
'
' Prep_Fails Macro
' Macro recorded 02/05/2007
'

' In A1 enter formula to copy Chassis only from data in F1
Range("A1").Select
ActiveCell.FormulaR1C1 = "=MID(RC[5],79,17)"
Range("A1").Select

' Autofill formula in column A
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A1").AutoFill Destination:=.Range("A1:A" & LastRow) _
, Type:=xlFillDefault
End With

' Copy formulae in column A paste as values, sort by chassis
Range("A1:A" & LastRow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Delete unneeded columns, autofit column A and sort
Columns("B:F").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Columns("A:A").EntireColumn.AutoFit
Range("A1:A" & LastRow).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

' In B1, enter formula to display "delete" if B2 is duplicate
Range("B1").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=R[1]C[-1],""delete"","""")"

' Autofill formula in column B
Dim LastRowB As Long
With ActiveSheet
LastRowB = .Cells(Rows.Count, "B").End(xlUp).Row
.Range("B1").AutoFill Destination:=.Range("B1:B" & LastRow) _
, Type:=xlFillDefault
End With

' Copy formulae in column B paste as values.
' Sort descending to bring "delete"s to the top
Range("A1:B" & LastRow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

'In G1, enter formula to apply 6 character code for AUT vehicles
ActiveWindow.ScrollColumn = 1
Application.Goto Reference:="R1C7"
Range("G1").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISNUMBER(FIND(""AUTFORD"",RC[-6])),""FORD00"",IF(ISNUMBER(FIND(""AUTVAUX"",RC[-6])),""VAUXHA"",IF(ISNUMBER(FIND(""VNVF1"",RC[-6])),""NISSAN"",IF(ISNUMBER(FIND(""VF1"",RC[-6])),""RENAUL"",IF(ISBLANK(RC[-6]),"""",""MISC00"")))))"
Range("G1").Select

' Autofill formula in column G
Dim LastRowG As Long
With ActiveSheet
LastRowG = .Cells(Rows.Count, "G").End(xlUp).Row
.Range("G1").AutoFill Destination:=.Range("G1:G" & LastRow) _
, Type:=xlFillDefault
End With

' In I1, enter formula to place VN value
Application.Goto Reference:="R1C9"
ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-8]),"""",""VN"")"
Range("I1").Select

' Autofill formula in column I
Dim LastRowI As Long
With ActiveSheet
LastRowI = .Cells(Rows.Count, "I").End(xlUp).Row
.Range("I1").AutoFill Destination:=.Range("I1:I" & LastRow) _
, Type:=xlFillDefault
End With

' In J1, enter formula to enter Import Centre code
Application.Goto Reference:="R1C10"
ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-9]),"""",""CIM0006C"")"
Range("J1").Select

' Autofill formula in column J
Dim LastRowJ As Long
With ActiveSheet
LastRowJ = .Cells(Rows.Count, "J").End(xlUp).Row
.Range("J1").AutoFill Destination:=.Range("J1:J" & LastRow) _
, Type:=xlFillDefault
End With

' Copy columns G to J and paste as values
Range("G:J").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Columns("G:J").EntireColumn.AutoFit

' Delete whole rows where value in column B = "delete"
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim LastRowC As Long, r As Long
LastRowC = ActiveSheet.UsedRange.Rows.Count
For r = LastRowC To 1 Step -1
If (Cells(r, 2).Value) = "delete" Then Rows(r).Delete
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

' In B1 enter formula to display chassis' beginning with a V
' Append a comma to these chassis'
Range("B1").Select
ActiveCell.FormulaR1C1 = "=IF(LEFT(RC[-1],1)=""V"",RC[-1]&"","","""")"

' Autofill formula in column B
Dim LastRowB2 As Long
With ActiveSheet
LastRowB2 = .Cells(Rows.Count, "B").End(xlUp).Row
.Range("B1").AutoFill Destination:=.Range("B1:B" & LastRow) _
, Type:=xlFillDefault
End With

' Copy and paste contents of column B as values
Range("B1:B" & LastRow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:B").EntireColumn.AutoFit

' Delete whole rows where column A appears to be blank
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Rng As Range, ix As Long
Set Rng = Intersect(Range("A:A"), ActiveSheet.UsedRange)
For ix = Rng.Count To 1 Step -1
If Trim(Replace(Rng.Item(ix).Text, Chr(160), Chr(32))) = "" Then
Rng.Item(ix).EntireRow.Delete
End If
Next
done:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

' Reset "used" range
x = ActiveSheet.UsedRange.Rows.Count
ActiveCell.SpecialCells(xlLastCell).Select

End Sub



The additional IFs I wanted to add in are as follows:

IF(ISNUMBER(FIND(""AUTNISS"",RC[-6])),""DELETE"",IF(ISNUMBER(FIND(""AUTRCI"",RC[-6])),""DELETE"",IF(ISNUMBER(FIND(""AUTVRS"",RC[-6])),""DELETE"",IF(ISNUMBER(FIND(""AUTWES"",RC[-6])),""DELETE""

As I said, I'm not a VBA genius, so I don't quite know how to go about applying these conditions without setting it as the formula.
I can sometimes create several of these files a day (exporting from Crystal). Therefore, retaining the macro is easy and convenient, as opposed to keeping a specific file that contains a VLOOKUP.
 

Attachments

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 807,865 other people just like you!

Latest posts

Staff online

Members online

Top