CODEWITHSUNDEEP
excelvba
Amrutha
Amrutha

Reputation: 1

Copy data from one table and Clear and update new data into another table in another sheet in excel 2010

I have a VBA macro which is currently copying data from Setup sheet and updating into the respective tables into Read_Only sheet for the first time. But when I click second time, it is adding the data into the respective tables in Read_Only sheet.

Now what I want is, if I click second time, it should first clear the existing data from that respective table in Read_Only sheet and then update the new data into that table. (For example: In 1st table, there were 10 rows of data, now when I click 2nd time I have only 8 rows of data, then macro should clear data existing 10 rows of data and update this new 8 rows of data and then delete the 2 empty two rows. This should be Dynamic, since number of rows may vary every time while updating new data)

Here is the existing code: 

Sub copyData()

    Dim wsSet As Worksheet
    Dim wsRead As Worksheet
    Dim rngSearch As Range
    Dim lastRow As Integer
    Dim i As Integer
    Dim wRow As Integer
    Dim strCat As String
    Dim catRow As Integer

    Set wsSet = ActiveWorkbook.Worksheets("Budget_Setup")
    Set wsRead = ActiveWorkbook.Worksheets("WBS_Overview_Read_only")
    Set rngSearch = wsRead.Range("A12:A1000")    'range in READ to search for category
    lastRow = wsSet.Range("B16").End(xlDown).Row     'last row of data in SET

    Application.ScreenUpdating = False

    For i = 17 To lastRow
        strCat = Left(wsSet.Range("b" & i).Value, 3)    'current category in SET
        catRow = rngSearch.Find(strCat).Row             'row of match in READ
        If wsRead.Range("a" & catRow + 1).Value = "" Then   'find the correct row to copy into
            wRow = catRow + 1
        Else
            wRow = wsRead.Range("a" & catRow).End(xlDown).Row + 1
            If wsRead.Range("e" & wRow).Value <> "" Then
                wsRead.Range("a" & wRow).EntireRow.Insert
            End If
        End If
        wsSet.Range("b" & i & ":f" & i).Copy
        wsRead.Range("a" & wRow).PasteSpecial
        Application.CutCopyMode = False
    Next i

    Application.ScreenUpdating = True

    Set wsRead = Nothing
    Set wsSet = Nothing
End Sub

Upvotes: 0

Views: 2009

Answers (3)

DaveU
DaveU

Reputation: 1082

See if this works for you. I added one line to your code:

For i = 17 To lastRow
    strCat = Left(wsSet.Range("b" & i).Value, 3)    'current category in SET
    catRow = rngSearch.Find(strCat).Row             'row of match in READ
    If wsRead.Range("a" & catRow + 1).Value = "" Then   'find the correct row to copy into
        wRow = catRow + 1

        wsRead.Rows(wRow).EntireRow.Insert 'I added this line

    Else
        wRow = wsRead.Range("a" & catRow).End(xlDown).Row + 1 'end of data
        If wsRead.Range("e" & wRow).Value <> "" Then

Now, run this code before running yours.

Sub deletePhases()
'   delete phases in Setup from ReadOnly
    Dim r As Range, Col As Collection
    Dim x As Long, l As Long

    With Budget_Setup
        Set r = .Range("b17", .Cells(.Rows.Count, 2).End(xlUp))
    End With
    If r.Row < 17 Then Exit Sub 'no data

    Set Col = New Collection 'build unique list
    On Error Resume Next
    For x = 1 To r.Rows.Count
        Col.Add Left(r(x).Value, 3), Left(r(x).Value, 3)
    Next x

    With ReadOnly
        For x = 1 To Col.Count
            l = .Columns(1).Find(Col(x)).Offset(1).Row '1 below heading
                Do Until .Cells(l, 1) = "" 'end of phase data
                    .Rows(l).Delete
                Loop
        Next x
    End With

End Sub

Upvotes: 0

Jaycal
Jaycal

Reputation: 2087

This code will first delete all the existing data in each of the sections on the Read_Only sheet; then, with one modification, your code can be run as is.

Add this line of code immediately after Application.ScreenUpdating = False

' Erase all data in the Read Only Sheet
    Set currentData = wsRead.Columns(4).Find("Subject")

    Do
        wsRead.Range(currentData.Offset(2, 0), _
            currentData.Offset(2, 0).End(xlDown).Offset(-1, 0)).EntireRow.Delete
        Set currentData = wsRead.Columns(4).FindNext(currentData)
    Loop Until Not currentData Is Nothing And currentData.Row = 12

This code uses the "Subject" and the "Budgeted Cost" cells to delete the existing data between it.

Next, add the following line of code immediately after wRow = catRow + 1

wsRead.Rows(wRow).EntireRow.Insert

this will add the first blank row of data to a given section. Your existing code will then insert the new data into the blank row

Upvotes: 1

DaveU
DaveU

Reputation: 1082

I'm not sure how you're defining your Phase.71, Phase.72, etc, ranges, but with the information we have, this might work for you.

Sub clearAll()
Dim r As Range, vArr, v
vArr = Array("Phase.71", "Phase.72", "Phase.73", "Phase.74", "Phase.75")
For Each v In vArr
    Set r = ReadOnly.Range(v)
    Set r = r.Offset(2).Resize(r.Rows.Count - 4)
    r.ClearContents
Next v
End Sub

Upvotes: 0

Related Questions