Copy cell address of duplicates from one sheet to another.

[daisy]

Hi,

I'm new in VBA programming and I need help.
I have one worksheet in my job named "Tudo" and there I have about 100 rules and the name of employees that need to follow these rules.
What I need is the worksheet named "Nomes com Regras" show me in each name which rules is for each person.
I'm attaching an example of what I need.
Please, can you help me?
dados.xlsx

[Simi]

Do you have the list of names in column "A" for the sheet "Nomes com Regras" or do we need to generate that list from the sheet "Tudo"

[Simi]

If you have the list of names on your sheet "Nomes com Regras" you can use the following code to do what you need, just put this in a new module.
It will go down the list of names you have in sheet 2 and find all locations of that name in the first sheet.

Sub names_rules_list()


Dim lRowTarget As Long
Dim lColTarget As Long
Dim lRowTargetTotal As Long


With Worksheets(2)
    lRowTargetTotal = .Cells(.Rows.Count, 1).End(xlUp).Row
End With


lColTarget = 2 'start in column B for reporting the first rule


For lRowTarget = 1 To lRowTargetTotal
    With Worksheets(1).UsedRange
        Set c = .Find(Worksheets(2).Cells(lRowTarget, 1), LookIn:=xlValues)
        If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            'c.Value = 5
            Worksheets(2).Cells(lRowTarget, lColTarget) = .Cells(1, c.Column)
            lColTarget = lColTarget + 1
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
        
    End With
    lColTarget = 2
    
Next lRowTarget


End Sub

[daisy]

Hi Simi,

It is exactly what I needed.
Thank you very much!!!!!

[Simi]

I'm glad it worked for you.

I copied the bulk of that from the help files in excel, I just had to modify it for your particular usage.
I always think it helps to know what kind of keywords or functions you need to look up.

[daisy]

Hi Simi,

Please, I need to copy from "Tudo" to "Nomes com Regras" it be like that:

A B C D E F G
1 aaa Regra1 Regra6
2
3
4 bbb
5
6
7 ccc

Columuns are merged in 3
Lines are mereged in 3

I built these codes:


' sort Rules in sheet 3
RowNum = Worksheets(3).UsedRange.Rows.Count


For R = 5 To RowNum + 1
Worksheets(3).Range("B" & R & ":LZ" & R).Sort Key1:=Worksheets(3).Range("A" & R), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight
Next R




I made this code, but it is very slow

'copy skiping lines between employees names from sheet 3 to sheet 4
Worksheets(3).Activate
lrow = Cells(Rows.Count, 1).End(xlUp).Row
j = 5
Range("A5").Select
For i = 5 To lrow
ActiveSheet.Cells(i, 1).Copy
Worksheets(4).Cells(j, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
j = j + 3
Next i

' Copy skiping columns for Regras from sheet 3 to 4
Worksheets(3).Activate
'lrow = Worksheets(4).UsedRange.Rows.Count
lrow = Worksheets(4).Cells(Rows.Count, 1).End(xlUp).Row
m = 2
j = 5
For i = 5 To lrow
lcol = Worksheets(3).Cells(i, Columns.Count).End(xlToLeft).Column
For k = 2 To lcol
ActiveSheet.Cells(i, k).Copy
Worksheets(4).Cells(j, m).PasteSpecial Paste:=xlValues
Worksheets(4).Cells(j, m).HorizontalAlignment = xlCenter
Worksheets(4).Cells(j, m).VerticalAlignment = xlCenter
Application.CutCopyMode = False
m = m + 3
Next k
m = 2
j = j + 3
Next i


'do the merges of employees names in sheet 4


Worksheets(4).Activate
j = 5
lrow = Worksheets(4).Cells(Rows.Count, 1).End(xlUp).Row
For i = 5 To lrow Step 3
Range(Cells(i, 1), Cells(i + 2, 1)).Select
Selection.Merge
Range(Cells(i, 1), Cells(i + 2, 1)).HorizontalAlignment = xlCenter
Range(Cells(i, 1), Cells(i + 2, 1)).VerticalAlignment = xlCenter
Next i

'do the merges of Rules in sheet 4
m = 4
j = 5
lrow = Worksheets(4).Cells(Rows.Count, 1).End(xlUp).Row
For i = 5 To lrow Step 3
lcol = Worksheets(4).Cells(i, Columns.Count).End(xlToLeft).Column
For k = 2 To lcol Step 3
Range(Cells(j, k), Cells(j, m)).Select
Selection.Merge
Range(Cells(i, k), Cells(i, m)).HorizontalAlignment = xlCenter
Range(Cells(i, k), Cells(i, m)).VerticalAlignment = xlCenter
m = m + 3
Next k
m = 4
j = j + 3
Next i


It works, but it is so slow. I have 75 employees and 100 rules. It is possible to optimize this code.