Help Modify My code - Returning same results twice

[Johnny Thunder]

Hey guys,

I have this code (below) that looks in column C and searches for values that are greater than 0.01 and if found pastes them in column G as a list. to test I entered in two cells to have values that were greater than 0.01 Cell C5 and Cell C9 and in my results the code is entering cell C5's cell address/Value twice? Not sure what I am doing wrong.

Excel 2010

Sub FindVaraince()
Dim ws As Worksheet
Dim c As Range


Dim FinalRow As Long
FinalRow = cells(Rows.Count, 2).End(xlUp).Row 'Finds Last row and excludes header


Set ws = ActiveSheet


For Each c In ws.Range("C2:C" & FinalRow)
    
    If c.Value >= 0.01 Then Rng = c.Address
         
    If c.Value >= 0.01 Then Rng2 = c.Value
    
    ws.Range("G" & Rows.Count).End(xlUp).Offset(1).Value = Rng
    ws.Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Rng2


Application.CutCopyMode = False
Application.DisplayAlerts = False
    
Next c

End Sub

 

[alansidman]

You still have the values in the variable Rng and Rng2. You need to empty those variables.

Try this and see if this is what you are looking for

Sub FindVaraince()
Dim ws As Worksheet
Dim c As Range




Dim FinalRow As Long
FinalRow = Cells(Rows.Count, 2).End(xlUp).Row 'Finds Last row and excludes header




Set ws = ActiveSheet




For Each c In ws.Range("C2:C" & FinalRow)
    
    If c.Value >= 0.01 Then Rng = c.Address
         
    If c.Value >= 0.01 Then Rng2 = c.Value
    
    ws.Range("G" & Rows.Count).End(xlUp).Offset(1).Value = Rng
    ws.Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Rng2
    Rng = ""
    Rng2 = ""


Application.CutCopyMode = False
Application.DisplayAlerts = False
    
Next c


End Sub

 

[Norie]

Try this.

Sub FindVaraince()
Dim ws As Worksheet
Dim c As Range
Dim FinalRow As Long

    FinalRow = Cells(Rows.Count, 2).End(xlUp).Row    'Finds Last row and excludes header

    Set ws = ActiveSheet

    For Each c In ws.Range("C2:C" & FinalRow)

        If c.Value >= 0.01 Then
            Rng = c.Address

            Rng2 = c.Value

            ws.Range("G" & Rows.Count).End(xlUp).Offset(1).Value = Rng
            ws.Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Rng2

        End If

    Next c
    
    Application.CutCopyMode = False
    Application.DisplayAlerts = False

End Sub

 

[Caleeco]

^^ Alternative Code. Dont really need the Rng & Rng2 variables:

Sub FindVaraince()
    Dim ws As Worksheet
    Dim c As Range
    Dim FinalRow As Long
    
    FinalRow = Cells(Rows.Count, 3).End(xlUp).Row 'Finds Last row and excludes header
    Set ws = ActiveSheet
    
    For Each c In ws.Range("C2:C" & FinalRow)
        
        If c.Value >= 0.01 Then
             With ws.Range("G" & Rows.Count).End(xlUp)
                .Offset(1).Value = c.Address
                .Offset(1, 1).Value = c.Value
             End With
        End If
    Next c
        
    Application.CutCopyMode = False
    Application.DisplayAlerts = False
End Sub

Caleeco

 

[Johnny Thunder]

You still have the values in the variable Rng and Rng2. You need to empty those variables.

Try this and see if this is what you are looking for

Sub FindVaraince()
Dim ws As Worksheet
Dim c As Range





Dim FinalRow As Long
FinalRow = Cells(Rows.Count, 2).End(xlUp).Row 'Finds Last row and excludes header




Set ws = ActiveSheet




For Each c In ws.Range("C2:C" & FinalRow)
    
    If c.Value >= 0.01 Then Rng = c.Address
         
    If c.Value >= 0.01 Then Rng2 = c.Value
    
    ws.Range("G" & Rows.Count).End(xlUp).Offset(1).Value = Rng
    ws.Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Rng2
    Rng = ""
    Rng2 = ""


Application.CutCopyMode = False
Application.DisplayAlerts = False
    
Next c


End Sub

thanks for the help on this. It worked!

 

[Johnny Thunder]

Thanks guys, the above codes all worked for me.

Happy to work with such a great community. I have another post out there that is similar in nature to this one, but wasn't getting any traction so I have been trying to piece meal my code. If you have a second please take a look at it link:

https://www.mrexcel.com/forum/excel...-return-values-column-below-excel-2010-a.html