Solved VBA Loop Range and Create New Range Based on Condition

Microsoft Excel 2010 - complete product...
August 7, 2018 at 06:44:14
Specs: Windows 7 x64, 2,4 GHz / 4 GB
I have a range defined in an Input box (oldRange). I use the code below to try and extract cell values in column A if the condition in column B is met and add them to a new range using Union.

This is the data:

        A          B
1    009123        1
2    009123        2
3    009509    
4    008326        3

oldRange is A1:A4

This is the vba:

Dim newRange As Range
Dim c As Range

For Each c In oldRange
    If c.Offset(, 1).Value <> "" And c.Offset(, 1).Value <> "no" Then
    If Not newRange Is Nothing Then
            Set newRange = Union(newRange, c)
        Else
            Set newRange = c
    End If
    End If
Next

newRange should contain the following values:
009123
009123
008326

I ran the code and newRange results in:
009123
009123

The code above skips both 009509 (cell A3) and 008326 (cell A4), even though for cell A4 the condition is met, so value in A4 should be added to newRange, an only cell A3 should be skipped.

Am I missing something?

I don't need to use Union. I need a working way of course.

message edited by Mrrrr


See More: VBA Loop Range and Create New Range Based on Condition

Reply ↓  Report •

#1
August 7, 2018 at 07:31:28
It's hard for us to test your code as written because we don't have the complete code, including the InputBox, etc.

The best I could do was hardcode stated the "oldRange" address ("A1:A4") and then use MsgBox as an output method. When I run the following code, I get 3 MsgBoxes: 009123, 009123 and 008326.

Are you sure that your oldRange is set to A1:A4?

Sub TestMrr()

Dim newRange As Range
Dim c As Range

'For Each c In oldRange (Replaced with a hardcoded Range address)
For Each c In Range("A1:A4")
    If c.Offset(, 1).Value <> "" And c.Offset(, 1).Value <> "no" Then
    If Not newRange Is Nothing Then
            Set newRange = Union(newRange, c)
        Else
            Set newRange = c
    End If
    End If
Next

'My output method
  For Each whatever In newRange
    MsgBox whatever
  Next
End Sub


BTW...I'm once again confused by your variable names. What exactly is "newRange"? Is it really a Range of cells in the workbook? If not, perhaps you should consider using a variable name that does not use the letters r-a-n-g-e. You've dimensioned it as a Range object, but if it's not really a Range, then that makes it confusing for readers to understand what your code is trying to do. You also run the risk of getting a Type Mismatch error if you try to use newRange as something other than a Range object somewhere else in your code.

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code

message edited by DerbyDad03


Reply ↓  Report •

#2
August 7, 2018 at 22:52:35
I'm sorry if my variables are again badly named. I understand a range is made of cells and oldRange is one, of course. And no it's not A1:A4, that was for the sake of the example. My range picked by inputbox is D12168:D12171.

I added the msgbox loop into my code and the msgbox displays all 3 values, but only 2 of them move to the next step of the code. The code is 200 lines long, but I thought it was something with my If conditions, something missing in the snippet i posted, since in Locals window it's there where it loses the last value. I don't know what is wrong and why msgbox shows all 3 values, but in Locals window the newRange gets only 2 values, the first 2 that meet the condition. My Locals window shows the first value being added to newRange, then the 2nd, then it skips the 3rd, then it skips the 4th.

I recreated my whole thinking in the code I post below, I hope this helps:

Option Explicit
Public oldRange As Range 'I am using this in the EmailWatcher class module, so I need it global
Public myInputRange As Range
Public olApp As Outlook.Application 'using this in the email part of the code
Public WatchEmails As New Collection 'using a class object to watch emails

Sub myInput()
Set myInputRange = Application.InputBox(prompt:="Select cells):", Type:=8) 
    If myInputRange is Nothing Then
        Exit Sub
    End if
End Sub

Sub boxToRNG()
Set oldRange = myInputRange
End Sub

Sub Mrrrr()

myInput
boxToRNG

' HERE SHOULD BE SOME CODE FOR CREATING SOME PDF FILES LATER TO BE ATTACHED TO AN EMAIL
' I am running a FOR loop through oldRange to insert some of its OFFSET values into word documents
' and make pdf files - there are no conflicting names, except I don't use "c" to loop, I use "nr",
' which I declared as an Object

Dim myList As Range 'changed name from newRange
Dim c As Range

' BELOW, CODE FOR CREATING A LIST (myList) OF VALUES MEETING THE CONDITIONS IN IF
For Each c In oldRange
    If c.Offset(, 3).Value <> "" And c.Offset(, 3).Value <> "no" Then
    If Not myList Is Nothing Then
            Set myList = Union(myList, c)
        Else
            Set myList = c
    End If
    End If
Next

' NEXT AN ARRAY TO REMOVE DUPLICATES FROM myList 

MailSend:
Dim strPath, strFile As String
Dim myArray As Variant
Dim counter As Long
Dim myDict As Object
Dim nxtItem As Long
Dim tmpBody As String

        strPath = "D:\PDF\"

        myArray = myList.Value
    Set myDict = CreateObject("Scripting.Dictionary")
        myDict.CompareMode = vbTextCompare
        
    For counter = 0 To UBound(myArray, 1)
        myDict.Item(myArray(counter, 1)) = myArray(counter, 1)
    Next

    If UBound(myArray) - LBound(myArray) + 1 = 0 Then
        tmpBody = tmpBody & "- no. " & myList.Value & vbNewLine & vbNewLine
    Else
        myArray = myDict.Items
        For nxtItem = 0 To UBound(myArray)
            tmpBody = tmpBody & "- no. " & myArray(nxtItem) & vbNewLine & vbNewLine
        Next
    End If

' HERE SHOULD BE SOME CODE FOR CREATING EMAIL BODY AND SIGNATURE AND THEN DISPLAY EMAIL

End Sub

message edited by Mrrrr


Reply ↓  Report •

#3
August 8, 2018 at 08:38:00
✔ Best Answer
Once again, I'm confused by what I am reading. It most definitely could be me, so bear with me.

I'll start by saying that I don't have time right now to set up a workbook to run your code against so what I am going to say next is based only on what I'm reading in this thread.

I noticed that the selected range mentioned in Response #2 contains 4 cells, D12168:D12171. What I don't see is what data is in those cells. Therefore I am assuming that it's the same data as in the example in the OP:

           D           E
12168    009123        1
12169    009123        2
12170    009509    
12171    008326        3


If that's the case, then newList should contain 009123, 009123, 008326.

Once that newList is created, your code removes the duplicates, so all that is left is 2 values, 009123 and 008326.

Why are you expecting 3 or 4 values when there are only 2 unique values that fit the conditions you've specified?

Did I miss something in your explanation of where the values get "lost"?

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code


Reply ↓  Report •
Related Solutions


Ask Question