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
    190
    Articles
    0
    Excel Version
    Version 2002 Build 12527.20194
    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
    190
    Articles
    0
    Excel Version
    Version 2002 Build 12527.20194
    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
    190
    Articles
    0
    Excel Version
    Version 2002 Build 12527.20194
    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
  •