Results 1 to 8 of 8
  1. #1
    Star Lounger
    Join Date
    Jun 2005
    Location
    Delaware
    Posts
    79
    Thanks
    0
    Thanked 0 Times in 0 Posts
    I am trying to modify the current VBA for an excel template. What I need the code to do is following:

    (1) I need it to look in a range of cells (Column E) for a range of account numbers, if the account number is found highlight the cell and provide a message if not found provide message no assets found.
    (2) I need it to look in Column D for a range of branch numbers if branch numbers 7450 - 8049 are found, I then need it to look in column E for accounts 500000- 699999. If these combinations are found I need it to highlight the cell and provide an error message. If the combination is not found, It provide a message " No need to check Manufacturing Accounts". Below is my code.

    Sub FixedAssets()
    Dim msg As Variant
    Dim NaturalCell As Range
    Dim BranchCell As Range
    Range("d18").Select
    Range(ActiveCell, "e2000").Select
    ActiveSheet.Unprotect

    For Each NaturalCell In Selection
    If NaturalCell.Value > 160000 And NaturalCell.Value <= 180000 Then
    With NaturalCell
    .Interior.Color = vbRed
    .Font.Color = vbWhite
    End With
    msg = True
    End If
    Next NaturalCell
    If msg = True Then
    MsgBox "Fixed Assets Involved!!!"
    Else
    MsgBox "No Fixed Asset accounts found"
    End If

    For NaturalCell In Selection
    If BranchCell.Value > 7449 And BranchCell.Value <= 8049 Then
    If NaturalCell.Value > 499999 And NaturalCell.Value <= 699999 Then
    With NaturalCell
    .Interior.Color = vbRed
    .Font.Color = vbWhite
    End With
    msg = True
    End If
    Next NaturalCell
    If msg = True Then
    MsgBox "Check Manufacturing Combination!!!"
    Else
    MsgBox "No Manufacturing - ok to Post"
    End If

    End Sub

  2. #2
    Platinum Lounger
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    3,616
    Thanks
    7
    Thanked 231 Times in 219 Posts
    You need to either set an object to the selection.
    e.g.
    set objTestCells = Range("d18", "e2000")
    For Each NaturalCell In objTestCells

    cheers, Paul

  3. #3
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,890
    Thanks
    0
    Thanked 188 Times in 172 Posts
    Hi yjones,

    Your code could be made much more efficient, by narrowing down the test range for each set of tests to just the column concerned, encompassing as much as possible in With ... End With statements and avoiding And tests. Switching off screen updating can als speeds things up significantly. Try the following revision:
    Code:
    Sub FixedAssets()
    Application.ScreenUpdating = False
    Dim msg As Variant, TestRange As Range, NaturalCell As Range, BranchCell As Range
    With ActiveSheet
        msg = False
        .Unprotect
        Set TestRange = .Range("D18:D2000")
        For Each NaturalCell In TestRange
            With NaturalCell
                If .Value > 160000 Then
                    If .Value <= 180000 Then
                        .Interior.Color = vbRed
                        .Font.Color = vbWhite
                        msg = True
                        'Exit For
                    End If
                End If
            End With
        Next NaturalCell
        If msg = True Then
            MsgBox "Fixed Assets Involved!!!"
        Else
            MsgBox "No Fixed Asset accounts found"
            'Exit Sub
        End If
        msg = False
        Set TestRange = .Range("E18:E2000")
        For Each BranchCell In TestRange
            With BranchCell
                If .Value > 7449 Then
                    If .Value <= 8049 Then
                        With .Range.Offset(BranchCell, -1, 0)
                            If .Value > 499999 Then
                                If .Value <= 699999 Then
                                    .Interior.Color = vbRed
                                    .Font.Color = vbWhite
                                    msg = True
                                    'Exit For
                                End If
                            End If
                        End With
                        'If msg = True Then Exit For
                    End If
                End If
            End With
        Next BranchCell
        If msg = True Then
            MsgBox "Check Manufacturing Combination!!!"
        Else
            MsgBox "No Manufacturing - OK to Post"
        End If
    End With
    Application.ScreenUpdating = True
    End Sub
    Note: I've added some commented-out lines to indicate where you might be able to exit the various loops etc at the first opportunity. I don't know if that suits your needs or if you need to process all potential cells.

    Finally, when posting code, please use code tags and structured code.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  4. #4
    Star Lounger
    Join Date
    Jun 2005
    Location
    Delaware
    Posts
    79
    Thanks
    0
    Thanked 0 Times in 0 Posts
    I have copied the revised code and pasted it over my original vba. I did receive a compile error: Argument not optional at the following line: With.Range.Offset(BranchCell, -1,0) . I changed Range to TestRange and I was able to step through the code without any errors.

    I am having an issue though and am not sure how to fix it. In the second section the test range is set at column e18:e2000. I need this to be columns D18:d2000. Column D houses the branchCell and Column E houses the Natural Cell. I thought it would be as simple as changing the D range to the E range but I reiceive the same error message as mentioned above. How do I get it to look at column D for values >7449 <=8049 and if it finds those values to then look in column E for values >499999 <= 699999?

    Thanks for your assistance.

  5. #5
    Platinum Lounger
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    3,616
    Thanks
    7
    Thanked 231 Times in 219 Posts
    If you are looking in D and then need to check E you need to change the offset to 1 instead of -1.

    cheers, Paul

  6. #6
    Star Lounger
    Join Date
    Jun 2005
    Location
    Delaware
    Posts
    79
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Thanks, but I changed the offset to 1 and i still received the same error on that line.

  7. #7
    Star Lounger
    Join Date
    Jun 2005
    Location
    Delaware
    Posts
    79
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Below is the complete modified code.

    Code:
    Sub FixedAssets()
    Application.ScreenUpdating = False
    Dim msg As Variant, TestRange As Range, NaturalCell As Range, BranchCell As Range
    With ActiveSheet
        msg = False
        .Unprotect
        Set TestRange = .Range("e18:e2000")
        For Each NaturalCell In TestRange
            With NaturalCell
                If .Value > 160000 Then
                    If .Value <= 180000 Then
                        .Interior.Color = vbRed
                        .Font.Color = vbWhite
                        msg = True
                        'Exit For
                    End If
                End If
            End With
        Next NaturalCell
        If msg = True Then
            MsgBox "Fixed Assets Involved!!!"
        Else
            MsgBox "No Fixed Asset accounts found"
            'Exit Sub
        End If
        msg = False
        Set TestRange = .Range("d18:d2000")
        For Each BranchCell In TestRange
            With BranchCell
                If .Value > 7449 Then
                    If .Value <= 8049 Then
                        With .TestRange.Offset(BranchCell, 1, 0)
                            If .Value > 499999 Then
                                If .Value <= 699999 Then
                                    .Interior.Color = vbRed
                                    .Font.Color = vbWhite
                                    msg = True
                                    'Exit For
                                End If
                            End If
                        End With
                        'If msg = True Then Exit For
                    End If
                End If
            End With
        Next BranchCell
        If msg = True Then
            MsgBox "Check Manufacturing Combination!!!"
        Else
            MsgBox "No Manufacturing - OK to Post"
        End If
    End With
    Application.ScreenUpdating = True
    End Sub

  8. #8
    Platinum Lounger
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    3,616
    Thanks
    7
    Thanked 231 Times in 219 Posts
    Shouldn't it be "With TestRange.Offset(BranchCell, 1, 0)". You shouldn't have a leading dot because TestRange is a variable, not an object attribute.

    cheers, Paul

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •