Results 1 to 5 of 5

Thread: Replace Data with VBA

  1. #1

    Replace Data with VBA



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

    Hello,

    I am facing a challenge with two excel tables I created. One Table is responsible for imputing data and the other stores data.

    Name Date Time Total
    Person 1 October 1, 2014 20 1140
    Person 2 October 1, 2014 20 2200
    Person 1 October 28, 2014 30 2000
    Person 2 October 28, 2014 40 3030
    Person 1 October 28, 2014 30 2100

    The data highlighted in red should replace the one in blue. How can i accomplish this using vba?

    Your help will be highly appreciated.

    Thank You!!!!....

  2. #2
    Conjurer WizzardOfOz's Avatar
    Join Date
    Sep 2013
    Location
    Australia
    Posts
    184
    Articles
    0
    Excel Version
    Office 365
    This should do it. Also added a test function at the end

    Code:
    Option Explicit
    
    
    Sub ReplaceDuplicate(ByVal sRange As Range)
    Dim oData
    Dim i As Long, j As Long, k As Long, iMaxRows As Long, iMaxCols, iLastRow As Long
    'get the data and dimensions
        oData = sRange.Value2
        iMaxRows = UBound(oData, 1)
        iMaxCols = UBound(oData, 2)
        
    'for each row check for duplicates
        For i = 2 To iMaxRows - 1
            For j = i + 1 To iMaxRows
                If oData(i, 1) <> "" And oData(i, 1) = oData(j, 1) And oData(i, 2) = oData(j, 2) Then
                    'found it so swap it
                    For k = 3 To iMaxCols
                        oData(i, k) = oData(j, k)
                    Next k
                    
                    'erase it
                    For k = 1 To iMaxCols
                        oData(j, k) = ""
                    Next k
                End If
            Next j
        Next i
        
    'bump up blank lines
        For i = 2 To iMaxRows - 1
            If oData(i, 1) = "" Then
                j = i + 1
                While oData(j, 1) = "" And j < iMaxRows
                    j = i + 1
                Wend
                
                For k = 1 To iMaxCols
                    oData(i, k) = oData(j, k)
                    oData(j, k) = ""
                Next k
            End If
        Next i
        
    'dump it back
        sRange.Value = oData
        
    End Sub
    
    
    Sub test()
        Call ReplaceDuplicate(Range("Sheet1!A1:D7"))   'Obviously you will need to edit this for the range you need
    End Sub

  3. #3
    Super Moderator Bob Phillips's Avatar
    Join Date
    Mar 2011
    Posts
    1,829
    Articles
    0
    Excel Version
    O365
    Another way

    Code:
    Public Sub ReformatData()
    Dim names As String
    Dim dates As String
    Dim times As String
    Dim formula As String
    Dim lastrow As Long
    Dim otherrow As Long
    Dim i As Long
    
    
        Application.ScreenUpdating = False
        
        With ActiveSheet
        
            lastrow = .Range("A1").End(xlDown).Row
            names = .Range("A1").Resize(lastrow).Address
            dates = .Range("B1").Resize(lastrow).Address
            times = .Range("C1").Resize(lastrow).Address
            formula = "MATCH(1,(" & names & "=A<row>)*(" & dates & "=B<row>)*(" & times & "=C<row>),0)"
            For i = lastrow To 2 Step -1
            
                otherrow = .Evaluate(Replace(formula, "<row>", i))
                If otherrow <> i Then
                
                    .Cells(otherrow, "D").Value = .Cells(i, "D").Value
                    .Rows(i).Delete
                End If
            Next i
        End With
        
        Application.ScreenUpdating = True
    End Sub

  4. #4
    Conjurer snb's Avatar
    Join Date
    May 2013
    Posts
    376
    Articles
    0
    Excel Version
    2020
    or:

    Code:
    Sub M_snb()
       Sheet2.[K1] = Join(Application.Index(Sheet2.Cells(Rows.Count, 1).End(xlUp).Resize(, 3).Value, 1, 0), "")
       Sheet2.Cells(Val(Replace(Trim(Join(Filter([transpose(if(sheet2!A1:A100="","~",if(sheet2!A1:A100&sheet2!B1:B100&sheet2!C1:C100=K1,row(1:100),"~")))], "~", False))), " ", "|")), 4) = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(, 3).Value
       Sheet2.[K1] = ""
    End Sub

  5. #5
    You guys are amazing!!!! Thank you for replying!!!!!

    Thank you so much!!!!!!

Tags for this Thread

Posting Permissions

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