For Each Row in Range

P

pwill

Active Member
Joined
Nov 22, 2015
Messages
406
Hi can anyone help with a macro or line of code that I can add to another macro?

I have data in "E4:K4" ​
and "E5:K26" Sheet1

For Each Row in Range
"E5:K26" if any Value is the same as any value in
Range "E4:K4" and the Count of the same Values For Each Row that Match/Duplicate any Value in
"E4:K4"​
is 1 then clear the duplicate cell for each row when the Count is only 1 (or less than 2)

ie

ABCDEFGHIJKL
1
2
3
41234567
5213321081912
6435570231520
71116187404628
8173245857822
93127368362776
101234567

<colgroup><col span="13"></colgroup><tbody>
</tbody>


​
​
Row "E5:K5" has a Count of 1 Value that is the same in
"E4:K4"
Row "E6:K6" has a Count of 2 Values that are the same in "E4:K4"​
<strike>
</strike>Row "E7:K7" has a Count of 1 Value that is the same in "E4:K4"
Row "E8:K8" has a Count of 2 Values that are the same in "E4:K4"
Row "9:K9" has a Count of 1 Value that is the same in "E4:K4"​
<strike>
</strike>Row "E10:K10" has a Count of 7 Values that are the same in "E4:K4"

So the results would be
G5 = Nothing
H7 =
Nothing​
K9 =
Nothing
​
ABCDEFGHIJKL
1
2
3
41234567
521331081912
6435570231520
7111618404628
8173245857822
9312736836277
101234567

<colgroup><col span="13"></colgroup><tbody>
</tbody>
<strike>
</strike>​
Any help would be much appreciated

Regards

pwill
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Sort by date Sort by votes
Try this:-

Code: 
[COLOR="Navy"]Sub[/COLOR] MG10Feb27
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Cl [COLOR="Navy"]As[/COLOR] Range, Rw [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("E5:k26")
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Range("E4:K4"): .Item(Dn.Value) = Empty: [COLOR="Navy"]Next[/COLOR]

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Rw [COLOR="Navy"]In[/COLOR] Rng.Rows
    [COLOR="Navy"]Set[/COLOR] Cl = Nothing: c = 0
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Cl [COLOR="Navy"]In[/COLOR] Rw.Cells
        [COLOR="Navy"]If[/COLOR] .exists(Cl.Value) [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            [COLOR="Navy"]Set[/COLOR] R = Cl
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Cl
   [COLOR="Navy"]If[/COLOR] c = 1 [COLOR="Navy"]Then[/COLOR] R.Value = ""
[COLOR="Navy"]Next[/COLOR] Rw
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
Try this:-

Code: 
[COLOR=navy]Sub[/COLOR] MG10Feb27
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, Cl [COLOR=navy]As[/COLOR] Range, Rw [COLOR=navy]As[/COLOR] Range, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] R [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Set[/COLOR] Rng = Range("E5:k26")
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Range("E4:K4"): .Item(Dn.Value) = Empty: [COLOR=navy]Next[/COLOR]

[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Rw [COLOR=navy]In[/COLOR] Rng.Rows
    [COLOR=navy]Set[/COLOR] Cl = Nothing: c = 0
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Cl [COLOR=navy]In[/COLOR] Rw.Cells
        [COLOR=navy]If[/COLOR] .exists(Cl.Value) [COLOR=navy]Then[/COLOR]
            c = c + 1
            [COLOR=navy]Set[/COLOR] R = Cl
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] Cl
   [COLOR=navy]If[/COLOR] c = 1 [COLOR=navy]Then[/COLOR] R.Value = ""
[COLOR=navy]Next[/COLOR] Rw
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
Click to expand...


Thank you MickG, works perfect :)

Just what I need much appreciated :)

pwill
 
Upvote 0
Hi MickG, Your code works great but i just thought?

I posted a thread called
Join and Index Data and to get the results I was after on that thread I run your code first then run the code from that thread 'Sub IndexMyData()' straight after.

I wondered if I could get the same results an easier way using just one Macro?

pwill



​
 
Last edited:
Upvote 0
You're welcome
It would be better if you explained what you are trying to achieve overall, its not too clear from your thread.
 
Upvote 0
Thanks MickG, ok here goes :)

The following code from Join and Index Data gives a set of results in Range "AN20:AT26" using every row in Data Range "E5:K26" based on Values in Range "E4:K4" and if I run your code first and clear any cells in the rows where only 1 value is duplicated from "E4:K4" and then run the following code from Join and Index Data the Results in Range
"AN20:AT26" only include the rows where 2 or more Values repeat per row
based on Values in Range "E4:K4" which is the end result I am after.

Code: 
[LEFT][COLOR=#333333][FONT=Verdana]Sub IndexMyData()
[/FONT][/COLOR][COLOR=#333333][FONT=monospace]
[/FONT][/COLOR][COLOR=#333333][FONT=Verdana]    Dim MyRow(26), InSht As Worksheet, OutSht As Worksheet
    Dim c As Integer
    Dim i As Long
    Dim j As Long
    Dim r As Long
    Dim MyResults
    Dim CustOrd
    Dim MyData
    Dim MyNums
    Dim MyLtrs
    
        Application.EnableEvents = False
    
        Set InSht = Sheet1
        Set OutSht = Sheet1
        Set MyResults = OutSht.Range("AN20:AT26")
    
        MyData = InSht.Range("E5:K30")
        MyNums = InSht.Range("D5:D30")
        MyLtrs = InSht.Range("E4:K4")
    
            For i = 1 To 26
                MyRow(i) = " " & Join(WorksheetFunction.Index(MyData, i, 0)) & " "
                CustOrd = CustOrd & MyNums(i, 1) & ","
            Next i
    
            MyResults.ClearContents
            For i = 1 To 7
            c = 0
        
            For j = 1 To 26
                If InStr(MyRow(j), " " & MyLtrs(1, i) & " ") > 0 Then
                    c = c + 1
                        MyResults.Cells(c, i) = MyNums(j, 1)
                        If c = 7 Then Exit For
                    End If
                Next j
            Next i
    
            With OutSht.Sort
                .SortFields.Clear
                    For i = 1 To 7
                        .SortFields.Add Key:=MyResults.Cells(i, 1), CustomOrder:=CVar(CustOrd)
                    Next i
                .SetRange MyResults
                .Orientation = xlLeftToRight
                .Apply
            End With
    
            Application.EnableEvents = True
    
End Sub[/FONT][/COLOR][/LEFT]

pwill
​
​
<strike></strike>
 
Last edited:
Upvote 0
My problem is I need to de-engineer you code to understand what its doing, and I don't want to do that, what I want is your data with expected results and an explanation of the process you need to follow to achieve those results.

For example in you results , last line you have the number 26, 3 times, I don't see that in your data !!!
 
Upvote 0
Hi MickG sorry for the confusion,

Using Numerical Values for the Data in Range "E4:K4" and "E5:K30"

Range "D5:D30" (Numbered 1 to 26) is the row reference for the Data in Range "E5:K30" so starting with the first Row of Data in "E5:K30" if that row has more than two duplicate values then the row reference from "D5:D26" for first duplicate value in that row is put into the results range "AN20" then looping through the rows if that same first duplicate value repeats again in another row with 2 or more repeating values from "E4:K4" then that row reference is put into the results "AN21" then loop through the rows again looking for the same first duplicate value if another row has the same value the row reference is put into the results "AN22". After checking all rows for the first duplicate.

The Row reference for 2nd duplicate value in the first row is put into "AO20" then the next Row reference for any rows with the same repeating value would gp in "AO21" and so on...
​
Then repeat the above for each row with 2 or more repeating values.

I hope that makes sense if not its ok I will just use your code first before running the other macro

pwill
 
Last edited:
Upvote 0
Try this:-
This is for 2 duplicate values
Results start "An1"
NB:- The results are not in the same order as your Results, but are the same, does that matter.???
Code: 
[COLOR="Navy"]Sub[/COLOR] MG11Feb07
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Cl [COLOR="Navy"]As[/COLOR] Range, Rw [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range("E5:k30")
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Range("E4:K4"): .Item(Dn.Value) = Empty: [COLOR="Navy"]Next[/COLOR]

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Rw [COLOR="Navy"]In[/COLOR] Rng.Rows
    [COLOR="Navy"]Set[/COLOR] Cl = Nothing: c = 0
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Cl [COLOR="Navy"]In[/COLOR] Rw.Cells
        [COLOR="Navy"]If[/COLOR] .exists(Cl.Value) [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Cl
   [COLOR="Navy"]If[/COLOR] c >= 2 [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Rw Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Rw)
   [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Rw

[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
ReDim ray(1 To nRng.Count, 1 To 7)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    Ac = Ac + 1: c = 0
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] nRng
       [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Dn
          [COLOR="Navy"]If[/COLOR] R = K [COLOR="Navy"]Then[/COLOR]
             c = c + 1
            ray(c, Ac) = Range("D" & R.Row).Value
           oMax = Application.Max(oMax, c)
           [COLOR="Navy"]End[/COLOR] If
       [COLOR="Navy"]Next[/COLOR] R
     [COLOR="Navy"]Next[/COLOR] Dn
 [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With

Range("An1").Resize(oMax, 7).Value = ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
Try this:-
This is for 2 duplicate values
Results start "An1"
NB:- The results are not in the same order as your Results, but are the same, does that matter.???
Code: 
[COLOR=navy]Sub[/COLOR] MG11Feb07
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, Cl [COLOR=navy]As[/COLOR] Range, Rw [COLOR=navy]As[/COLOR] Range, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] R [COLOR=navy]As[/COLOR] Range, nRng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] K [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Set[/COLOR] Rng = Range("E5:k30")
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Range("E4:K4"): .Item(Dn.Value) = Empty: [COLOR=navy]Next[/COLOR]

[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Rw [COLOR=navy]In[/COLOR] Rng.Rows
    [COLOR=navy]Set[/COLOR] Cl = Nothing: c = 0
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Cl [COLOR=navy]In[/COLOR] Rw.Cells
        [COLOR=navy]If[/COLOR] .exists(Cl.Value) [COLOR=navy]Then[/COLOR]
            c = c + 1
            
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] Cl
   [COLOR=navy]If[/COLOR] c >= 2 [COLOR=navy]Then[/COLOR]
        [COLOR=navy]If[/COLOR] nRng [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR] [COLOR=navy]Set[/COLOR] nRng = Rw Else [COLOR=navy]Set[/COLOR] nRng = Union(nRng, Rw)
   [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Rw

[COLOR=navy]Dim[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] oMax [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
ReDim ray(1 To nRng.Count, 1 To 7)
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
    Ac = Ac + 1: c = 0
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] nRng
       [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] R [COLOR=navy]In[/COLOR] Dn
          [COLOR=navy]If[/COLOR] R = K [COLOR=navy]Then[/COLOR]
             c = c + 1
            ray(c, Ac) = Range("D" & R.Row).Value
           oMax = Application.Max(oMax, c)
           [COLOR=navy]End[/COLOR] If
       [COLOR=navy]Next[/COLOR] R
     [COLOR=navy]Next[/COLOR] Dn
 [COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With

Range("An1").Resize(oMax, 7).Value = ray
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
Click to expand...

Thank you MickG sorry for the delay, only just seen your reply. Perfect, just what I was after :) doesn't matter about the order

Thanks for your time, much appreciated.

pwill
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question
Formula to count duplicate Values every x # of rows
Replies
8
Views
261
Fluff
Fluff
M
  • Solved
Counting how much number is in ascending order in a row.
2
Replies
12
Views
359
Peter_SSs
Peter_SSs
M
  • Question
Returning Values Based on Referent Cells (Avoiding Redundant Values)
Replies
5
Views
249
Fluff
Fluff
gtd526
  • Question
convert cell value to formula
Replies
8
Views
168
Fluff
Fluff
I
  • Question
Is it possible to insert/delete rows in a file and make other files automatically update their rows accordingly?
Replies
3
Views
178
jkpieterse
jkpieterse

Forum statistics

Threads
1,214,651
Messages
6,120,744
Members
448,989
Latest member
mariah3

Share this page

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