Copy cell address of duplicates from one sheet to another.

D

daisy

New member
Joined
Mar 12, 2014
Messages
3
Reaction score
0
Points
0
Location
Campinas - São Paulo - Brazil
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?
View attachment dados.xlsx
 
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"
 
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.


Code: 
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
 
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.
 
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.
 
You must log in or register to reply here.
Back
Top