Range Issue

Darren Smith

Well-known Member
Joined
Nov 23, 2020
Messages
631
Office Version
  1. 2019
Platform
  1. Windows
This code is to find the array Transit in column E then replace it but for some reason, the rng variable and FirstAddress remain blank?
I could send the workbook if that helps?

VBA Code:
Option Explicit
Sub Vehicle_Name_Replace()

    Dim FirstAddress As String
    Dim MyArr As Variant
    Dim ws As Worksheet
    Dim rng As Range, DRng As Range
    Dim x As Long
    Dim i As Long
    Dim VModel As ComboBox

Set VModel = Body_And_Vehicle_Type_Form.Model_Type

Set ws = ThisWorkbook.Worksheets("Job Card Master")

    MyArr = Array("Transit")
    
    With ws.Range("E:E")

            For i = LBound(MyArr) To UBound(MyArr)


            Set rng = .Find(What:=MyArr(i), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=True)

            If Not rng Is Nothing Then
            
            FirstAddress = rng.Address
                Do
                    
                   Set DRng = rng
                    
                Select Case VModel.Value
     
                    Case ("Sprinter")
                    DRng.Value = "Sprinter"
                    
                    Case ("Master")
                    DRng.Value = "Master Movano NV400"
                    
                    Case ("Movano")
                    DRng.Value = "Master Movano NV400"
                    
                    Case ("NV400")
                    DRng.Value = "Master Movano NV400"
                    
                    Case ("Boxer")
                    DRng.Value = "Boxer Ducato Relay"
                    
                    Case ("Ducato")
                    DRng.Value = "Boxer Ducato Relay"
                    
                    Case ("Relay")
                    DRng.Value = "Boxer Ducato Relay"
                    
                    End Select
            Set rng = .FindNext(rng)
                Loop While Not rng Is Nothing And rng.Address <> FirstAddress
            End If
            
            Next i
            
    End With

End Sub
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Using merged cells is a terrible idea and it will put seasoned users off straight away.
In most instances you can use Center Across Selection to achieve a similar purpose.

I am in Australia and will be login off shortly but you can try these changes.
Change the columns to search to both E & F compliments of the merged cells and as Marc L suggested in post #18

VBA Code:
With Sheet7.Range("E:F")

This part of the code needs to be dumped / deleted.
Your code is setting Rf to nothing here, so it then skips the rest of the code because the next test is also to test for nothing.

DELETE
VBA Code:
        If Not Rf Is Nothing Then
            Debug.Print Rf.Address
            Application.Speech.Speak "Found in cell " & Rf.Address(False, False)
            Set Rf = Nothing
          End If

Unless I have misunderstood the requirements, change all of your case statements to this format.
VBA Code:
                    Case ("Sprinter")
                    DRng.Value = Replace(Rf.Value, "Transit", "Sprinter")



Center Across Selection

1622034643188.png
 
Upvote 0
The
Using merged cells is a terrible idea and it will put seasoned users off straight away.
In most instances you can use Center Across Selection to achieve a similar purpose.

I am in Australia and will be login off shortly but you can try these changes.
Change the columns to search to both E & F compliments of the merged cells and as Marc L suggested in post #18

VBA Code:
With Sheet7.Range("E:F")

This part of the code needs to be dumped / deleted.
Your code is setting Rf to nothing here, so it then skips the rest of the code because the next test is also to test for nothing.

DELETE
VBA Code:
        If Not Rf Is Nothing Then
            Debug.Print Rf.Address
            Application.Speech.Speak "Found in cell " & Rf.Address(False, False)
            Set Rf = Nothing
          End If

Unless I have misunderstood the requirements, change all of your case statements to this format.
VBA Code:
                    Case ("Sprinter")
                    DRng.Value = Replace(Rf.Value, "Transit", "Sprinter")



Center Across Selection

View attachment 39458
The rng still not working even with the alterations you said to make
See code below

VBA Code:
Option Explicit
Sub Chassis_Replace()

Dim FirstAddress As String
Dim MyArr As Variant
Dim ws As Worksheet
Dim DRng As Range, rng As Range
Dim x As Long
Dim i As Long
Dim VModel As ComboBox

Set VModel = Body_And_Vehicle_Type_Form.Model_Type
Set ws = ThisWorkbook.Worksheets("Job Card Master")

With ws.UsedRange.Columns("E:F")


    If Not rng Is Nothing Then
            
    FirstAddress = rng.Address
    
         Do
        
        Set DRng = rng
        Select Case VModel.Value
        
        Case ("Sprinter")
        DRng.Value = Replace(rng.Value, "Transit", "Sprinter")
        
        Case ("Master")
        DRng.Value = Replace(rng.Value, "Transit", "Master Movano NV400")
        
        Case ("Movano")
        DRng.Value = Replace(rng.Value, "Transit", "Master Movano NV400")
        
        Case ("NV400")
        DRng.Value = Replace(rng.Value, "Transit", "Master Movano NV400")
        
        Case ("Boxer")
        DRng.Value = Replace(rng.Value, "Transit", "Boxer Ducato Relay")
        
        Case ("Ducato")
        DRng.Value = Replace(rng.Value, "Transit", "Boxer Ducato Relay")
        
        Case ("Relay")
        DRng.Value = Replace(rng.Value, "Transit", "Boxer Ducato Relay")
        
        End Select
        
        Set rng = .FindNext(rng)
        Loop While Not DRng Is Nothing And DRng.Address <> FirstAddress
        
        End If
        
        End With
        
        End Sub
 
Upvote 0
OK we seem to be having some version control issues.
Make sure you have a copy of your current position and then replace your current version of the sub Chassis_Replace with the one below.
(Chassis_Replace in your original posting and the file you attached in post #6 seems to have been called Vehicle_Name_Replace)

Let me know how you go.

VBA Code:
Sub Chassis_Replace()

    Dim FirstAddress As String
    Dim MyArr As Variant
    Dim ws As Worksheet
    Dim DRng As Range, Rf As Range
    Dim x As Long
    Dim i As Long
    Dim VModel As ComboBox
    Dim strModel

    Set VModel = Body_And_Vehicle_Type_Form.Model_Type
    Set ws = ThisWorkbook.Worksheets("Job Card Master")

    With ws.Range("E:F")
       
        Set Rf = .Find("Transit", , xlValues, xlPart)
           
        If Not Rf Is Nothing Then
           
           FirstAddress = Rf.Address
            Do
                Set DRng = Rf
                
                strModel = ""
                Select Case VModel.Value
        
                    Case ("Sprinter")
                        strModel = "Sprinter"
                    
                    Case ("Master")
                        strModel = "Master Movano NV400"
                    
                    Case ("Movano")
                        DRng.Value = "Master Movano NV400"
                    
                    Case ("NV400")
                        strModel = "Master Movano NV400"
                    
                    Case ("Boxer")
                        strModel = "Boxer Ducato Relay"
                    
                    Case ("Ducato")
                        strModel = "Boxer Ducato Relay"
                    
                    Case ("Relay")
                        strModel = "Boxer Ducato Relay"
                       
                End Select
                
                If strModel <> "" Then
                    DRng.Value = Replace(Rf.Value, "Transit", strModel)
                End If
                
                Set Rf = .FindNext(Rf)
            Loop While Not Rf Is Nothing And Rf.Address <> FirstAddress
        End If

    End With

End Sub
 
Upvote 0
OK we seem to be having some version control issues.
Make sure you have a copy of your current position and then replace your current version of the sub Chassis_Replace with the one below.
(Chassis_Replace in your original posting and the file you attached in post #6 seems to have been called Vehicle_Name_Replace)

Let me know how you go.

VBA Code:
Sub Chassis_Replace()

    Dim FirstAddress As String
    Dim MyArr As Variant
    Dim ws As Worksheet
    Dim DRng As Range, Rf As Range
    Dim x As Long
    Dim i As Long
    Dim VModel As ComboBox
    Dim strModel

    Set VModel = Body_And_Vehicle_Type_Form.Model_Type
    Set ws = ThisWorkbook.Worksheets("Job Card Master")

    With ws.Range("E:F")
     
        Set Rf = .Find("Transit", , xlValues, xlPart)
         
        If Not Rf Is Nothing Then
         
           FirstAddress = Rf.Address
            Do
                Set DRng = Rf
              
                strModel = ""
                Select Case VModel.Value
      
                    Case ("Sprinter")
                        strModel = "Sprinter"
                  
                    Case ("Master")
                        strModel = "Master Movano NV400"
                  
                    Case ("Movano")
                        DRng.Value = "Master Movano NV400"
                  
                    Case ("NV400")
                        strModel = "Master Movano NV400"
                  
                    Case ("Boxer")
                        strModel = "Boxer Ducato Relay"
                  
                    Case ("Ducato")
                        strModel = "Boxer Ducato Relay"
                  
                    Case ("Relay")
                        strModel = "Boxer Ducato Relay"
                     
                End Select
              
                If strModel <> "" Then
                    DRng.Value = Replace(Rf.Value, "Transit", strModel)
                End If
              
                Set Rf = .FindNext(Rf)
            Loop While Not Rf Is Nothing And Rf.Address <> FirstAddress
        End If

    End With

End Sub
This works fine except for the below comment.
Loop While Not Rf Is Nothing And Rf.Address <> FirstAddress
The code above says "Block Variable not set"
 
Upvote 0
Very sorry it`s fine now my mistake. Replaced DRng with your StrModel it now works
 
Upvote 0

Forum statistics

Threads
1,216,071
Messages
6,128,623
Members
449,460
Latest member
jgharbawi

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