Results 1 to 6 of 6

Thread: Copy cell address of duplicates from one sheet to another.

  1. #1
    Neophyte daisy's Avatar
    Join Date
    Mar 2014
    Location
    Campinas - São Paulo - Brazil
    Posts
    3
    Articles
    0

    Copy cell address of duplicates from one sheet to another.



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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

  2. #2
    Conjurer Simi's Avatar
    Join Date
    Feb 2012
    Location
    Utah, USA
    Posts
    187
    Articles
    0
    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"

  3. #3
    Conjurer Simi's Avatar
    Join Date
    Feb 2012
    Location
    Utah, USA
    Posts
    187
    Articles
    0
    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

  4. #4
    Neophyte daisy's Avatar
    Join Date
    Mar 2014
    Location
    Campinas - São Paulo - Brazil
    Posts
    3
    Articles
    0
    Hi Simi,

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

  5. #5
    Conjurer Simi's Avatar
    Join Date
    Feb 2012
    Location
    Utah, USA
    Posts
    187
    Articles
    0
    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.

  6. #6
    Neophyte daisy's Avatar
    Join Date
    Mar 2014
    Location
    Campinas - São Paulo - Brazil
    Posts
    3
    Articles
    0
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •