1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

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

Discussion in 'Software Development' started by Gram123, Apr 6, 2010.

Thread Status:
Not open for further replies.
  1. Gram123

    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.
     
  2. Ent

    Ent Trusted Advisor

    Joined:
    Apr 11, 2009
    Messages:
    5,467
    First Name:
    Josiah
    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.
     
  3. Gram123

    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.
     

    Attached Files:

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 733,556 other people just like you!

Loading...
Similar Threads - problem many Convert
  1. n00e
    Replies:
    2
    Views:
    387
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/915104

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice