Consulting

Results 1 to 8 of 8

Thread: VBA coding help

  1. #1

    VBA coding help

    Hi Everyone,

    I am looking to have some code take the data, sort by number and then by edit date. Step 2 would be to put a space when it sees a new number, Step 3 to take the highest time stamp and copy that row to another tab. End result would be all the highest time stamp on one tab. I have attached a sample file. thank you in advance for all your help! Also , Office 365

    Tea
    Attached Files Attached Files

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,086
    Location
    Public Sub Reorganise()
    Dim lastrow As Long
    Dim nextrow As Long
    Dim targetrow As Long
    Dim i As Long
    
        Application.ScreenUpdating = False
        
        With ActiveSheet
        
            .Range("A1:C1").Copy .Range("G1")
        
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("A1:C1").Resize(lastrow).Sort Key1:=.Range("A1"), Order1:=xlAscending, _
                                                 Key2:=.Range("C1"), Order2:=xlAscending, _
                                                 Header:=xlYes
            nextrow = 2
            targetrow = 2
            For i = 3 To lastrow + 1
            
                If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then
                
                    If .Cells(i, "C").Value > .Cells(targetrow, "C").Value Then
                    
                        targetrow = i
                    End If
                Else
                
                    .Cells(targetrow, "A").Resize(, 3).Copy .Cells(nextrow, "G")
                    nextrow = nextrow + 1
                    targetrow = i
                End If
            Next i
        End With
        
        Application.ScreenUpdating = True
    End Sub
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    Works Great, Thank you! Just one modification. Can I have it copy to a new tab instead of in column G? Thanks for your help!
    Tea

  4. #4
    VBAX Mentor paulked's Avatar
    Joined
    Apr 2006
    Posts
    394
    Location
    Change the red to suit?
    Public Sub Reorganise()
    Dim lastrow As Long
    Dim nextrow As Long
    Dim targetrow As Long
    Dim i As Long
    
    
        Application.ScreenUpdating = False
        
        With ActiveSheet
        
            .Range("A1:C1").Copy Sheet2.Range("A1")
        
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("A1:C1").Resize(lastrow).Sort Key1:=.Range("A1"), Order1:=xlAscending, _
                                                 Key2:=.Range("C1"), Order2:=xlAscending, _
                                                 Header:=xlYes
            nextrow = 2
            targetrow = 2
            For i = 3 To lastrow + 1
            
                If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then
                
                    If .Cells(i, "C").Value > .Cells(targetrow, "C").Value Then
                    
                        targetrow = i
                    End If
                Else
                
                    .Cells(targetrow, "A").Resize(, 3).Copy Sheet2.Cells(nextrow, "A")
                    nextrow = nextrow + 1
                    targetrow = i
                End If
            Next i
        End With
        
        Application.ScreenUpdating = True
    End Sub
    Semper in excretia sumus; solum profundum variat.

  5. #5
    Perfect!! thank you all for your help! I wish it was that easy for me! lol

  6. #6
    Well i thought that would work but it didnt copy over to sheet2. Any thoughts? I changed code to what you had listed in red.

  7. #7
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,086
    Location
    The only way that could be so is if your sheet codename is not Sheet2.

    Does this work?

    Public Sub Reorganise()
    Dim lastrow As Long
    Dim nextrow As Long
    Dim targetrow As Long
    Dim i As Long
    
        Application.ScreenUpdating = False
        
        With ActiveSheet
        
            .Range("A1:C1").Copy Worksheets("Sheet2").Range("A1")
        
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("A1:C1").Resize(lastrow).Sort Key1:=.Range("A1"), Order1:=xlAscending, _
                                                 Key2:=.Range("C1"), Order2:=xlAscending, _
                                                 Header:=xlYes
            nextrow = 2
            targetrow = 2
            For i = 3 To lastrow + 1
            
                If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then
                
                    If .Cells(i, "C").Value > .Cells(targetrow, "C").Value Then
                    
                        targetrow = i
                    End If
                Else
                
                    .Cells(targetrow, "A").Resize(, 3).Copy Worksheets("Sheet2").Cells(nextrow, "A")
                    nextrow = nextrow + 1
                    targetrow = i
                End If
            Next i
        End With
        
        Application.ScreenUpdating = True
    End Sub
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  8. #8
    Yes that did it! thanks!

Posting Permissions

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