I need an alternative to a if statement

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,362
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have some code that is meant to copy rows in a spreadsheet depending on the value of the cell in column F for that row. I need to be able to distinguish between having the value to be Ang Wes or Ang Riv. At the moment, regardless of the value, it will always default to Ang Riv but I need DocYearName to be the value in column 36 if Ang Wes is entered in column 6.

I think I need a select case statement or something similar but I am not sure of the code. Can someone help me please?

Code:
           If tblrow.Range.Cells(1, 6).Value = "Ang Wes" Then
                DocYearName = tblrow.Range.Cells(1, 37).Value
            Else
                DocYearName = tblrow.Range.Cells(1, 36).Value
            End If
            
            If tblrow.Range.Cells(1, 6).Value = "Ang Riv" Then
                DocYearName = tblrow.Range.Cells(1, 37).Value
            Else
                DocYearName = tblrow.Range.Cells(1, 36).Value
            End If
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Try this

Code:
    Select Case tblrow.Cells(1, 6).Value
      Case "Ang Wes", "Ang Riv"
        DocYearName = tblrow.Range.Cells(1, 37).Value
      Case Else
        DocYearName = tblrow.Range.Cells(1, 36).Value
    End Select
 
Upvote 0
I already solved the problem with this code:

Code:
           If (tblrow.Range.Cells(1, 6).Value = "Ang Wes" Or tblrow.Range.Cells(1, 6).Value = "Ang Riv") Then
               DocYearName = tblrow.Range.Cells(1, 37).Value
           Else
               DocYearName = tblrow.Range.Cells(1, 36).Value
           End If

but I think that your way is a better way to write the code.

Thank you.
 
Upvote 0
Actually, it doesn't work as it is in a for each statement. Here is the full procedure:

Code:
Sub cmdCopy()
        Dim wsDst As Worksheet, wsSrc As Worksheet, tblrow As ListRow
        Dim Combo As String, sht As Worksheet, tbl As ListObject
        Dim LastRow As Long, DocYearName As String, lr As Long
        Dim w As Window, wb As Workbook
            Application.ScreenUpdating = False
        'assign values to variables
        Set tbl = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting")
        For Each tblrow In tbl.ListRows
            If tblrow.Range.Cells(1, 1).Value = "" Or tblrow.Range.Cells(1, 5).Value = "" Or tblrow.Range.Cells(1, 6).Value = "" Then
                MsgBox "The Date, Service or Requesting Organisation has not been entered for every record in the table"
                Exit Sub
            End If
        Next tblrow
        For Each tblrow In tbl.ListRows
            Combo = tblrow.Range.Cells(1, 26).Value
            
            
            Select Case tblrow.Cells(1, 6).Value
              Case "Ang Wes", "Ang Riv"
                DocYearName = tblrow.Range.Cells(1, 37).Value
              Case Else
                DocYearName = tblrow.Range.Cells(1, 36).Value
            End Select
            
            
            If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & DocYearName & ".xlsm"

            Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
             lr = wsDst.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
             With wsDst
                    'This copies the first 16 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                    tblrow.Range.Resize(, 16).Copy
                    'This pastes in the figures in the first 10 columns starting in column A
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
                    'Overwrites the numbers pasted to column I with a formula
                    .Range("I" & .Range("I" & .Rows.Count).End(xlUp).Row).Formula = "=IF(R[0]C[-4]=""Activities"",0,RC[-1]*0.1)"
                    'Overwrites the numbers pasted to column J with a formula
                    .Range("J" & .Range("J" & .Rows.Count).End(xlUp).Row).Formula = "=IF(R[1]C[-5]=""Activities"",RC[-2],RC[-1]+RC[-2])"
                    'sort procedure copied from vba
                    wsDst.Sort.SortFields.Clear
                    wsDst.Sort.SortFields.Add Key:=Range("A4:A" & lr), _
                        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                            With Workbooks(DocYearName).Worksheets(Combo).Sort
                                .SetRange Range("A3:AK" & lr)
                                .header = xlYes
                                .MatchCase = False
                                .Orientation = xlTopToBottom
                                .SortMethod = xlPinYin
                                .Apply
                            End With
                    'ActiveWorkbook.Save
                    'ActiveWorkbook.Close
                End With
        Next tblrow
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
End Sub
 
Upvote 0
I get the error of object doesn't support this property or method with the line with select case highlighted.
 
Upvote 0
I already solved the problem with this code:

Code:
           If (tblrow.Range.Cells(1, 6).Value = "Ang Wes" Or tblrow.Range.Cells(1, 6).Value = "Ang Riv") Then
               DocYearName = tblrow.Range.Cells(1, 37).Value
           Else
               DocYearName = tblrow.Range.Cells(1, 36).Value
           End If

but I think that your way is a better way to write the code.
(Untested) I believe this single line of code can replace the code you posted above...
Code:
[table="width: 500"]
[tr]
	[td]  DocYearName = tblrow.Range.Cells(1, 36 - (tblrow.Range.Cells(1, 6) = "Ang Wes" Or tblrow.Range.Cells(1, 6) = "Ang Riv"))[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0
Thanks for that Rick, it appears to work. I will just have to do some more testing and I will let you know if there is a problem.
 
Upvote 0
In some cases it is more practical or even, the code is clearer, when you use the Select Case statement.

For example, for 6 data:

Code:
    Select Case tblrow.Cells(1, 6).Value
      Case "Ang Wes", "Ang Riv", "other1", "other2", "other3", "Other4"
        DocYearName = tblrow.Range.Cells(1, 37).Value
      Case Else
        DocYearName = tblrow.Range.Cells(1, 36).Value
    End Select

With If Then Else Sentece:

Code:
     If tblrow.Range.Cells(1, 6).Value = "Ang Wes" Or tblrow.Range.Cells(1, 6).Value = "Ang Riv" Or _
        tblrow.Range.Cells(1, 6).Value = "Other1" Or tblrow.Range.Cells(1, 6).Value = "Other2" Or _
        tblrow.Range.Cells(1, 6).Value = "Other3" Or tblrow.Range.Cells(1, 6).Value = "Other4" Then
          DocYearName = tblrow.Range.Cells(1, 37).Value
      Else
          DocYearName = tblrow.Range.Cells(1, 36).Value
     End If
--------------------------------

object doesn't support this property or method

I think Range was missing.

Actually, it doesn't work as it is in a for each statement. Here is the full procedure:

Code:
Sub cmdCopy()
        Dim wsDst As Worksheet, wsSrc As Worksheet, tblrow As ListRow
        Dim Combo As String, sht As Worksheet, tbl As ListObject
        Dim LastRow As Long, DocYearName As String, lr As Long
        Dim w As Window, wb As Workbook
            Application.ScreenUpdating = False
        'assign values to variables
        Set tbl = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting")
        For Each tblrow In tbl.ListRows
            If tblrow.Range.Cells(1, 1).Value = "" Or tblrow.Range.Cells(1, 5).Value = "" Or tblrow.Range.Cells(1, 6).Value = "" Then
                MsgBox "The Date, Service or Requesting Organisation has not been entered for every record in the table"
                Exit Sub
            End If
        Next tblrow
        For Each tblrow In tbl.ListRows
            Combo = tblrow.Range.Cells(1, 26).Value
            
            
            Select Case tblrow.[COLOR=#ff0000]Range[/COLOR].Cells(1, 6).Value
              Case "Ang Wes", "Ang Riv"
                DocYearName = tblrow.Range.Cells(1, 37).Value
              Case Else
                DocYearName = tblrow.Range.Cells(1, 36).Value
            End Select
            
            
            If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & DocYearName & ".xlsm"

            Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
             lr = wsDst.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
             With wsDst
                    'This copies the first 16 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                    tblrow.Range.Resize(, 16).Copy
                    'This pastes in the figures in the first 10 columns starting in column A
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
                    'Overwrites the numbers pasted to column I with a formula
                    .Range("I" & .Range("I" & .Rows.Count).End(xlUp).Row).Formula = "=IF(R[0]C[-4]=""Activities"",0,RC[-1]*0.1)"
                    'Overwrites the numbers pasted to column J with a formula
                    .Range("J" & .Range("J" & .Rows.Count).End(xlUp).Row).Formula = "=IF(R[1]C[-5]=""Activities"",RC[-2],RC[-1]+RC[-2])"
                    'sort procedure copied from vba
                    wsDst.Sort.SortFields.Clear
                    wsDst.Sort.SortFields.Add Key:=Range("A4:A" & lr), _
                        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                            With Workbooks(DocYearName).Worksheets(Combo).Sort
                                .SetRange Range("A3:AK" & lr)
                                .header = xlYes
                                .MatchCase = False
                                .Orientation = xlTopToBottom
                                .SortMethod = xlPinYin
                                .Apply
                            End With
                    'ActiveWorkbook.Save
                    'ActiveWorkbook.Close
                End With
        Next tblrow
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thanks Dante, the code is clearer to read. I added the .range as you suggested and it worked great!! :)

Dave
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,238
Messages
6,170,939
Members
452,368
Latest member
jayp2104

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