VBA Code Modification, Command button to copy data based on row number.

mamun.ges · Sep 11th 2021

Hi, I am using the below code which needs some modification.

When I click on the command button, it copies the data to another sheet paste it to the defined row.

But If there is old data that exists already it does nothing.

I want it to clear the previous data and paste the current data.

Here is the code:

Code

Sub Update()

Dim wsSource As Worksheet: Set wsSource = Sheets("Source")
Dim lastrow As Long: lastrow = wsSource.Cells(Rows.Count, 1).End(xlUp).Row
Dim wsDest As Worksheet: Set wsDest = Sheets("Dest")
Dim rngRows As Range: Set rngRows = wsSource.Range("A2:A4")
Dim rng As Range

wsDest.Range("A1").Value = ""

For Each rng In rngRows
    If rng = "" Then
        rng = rng

    ElseIf wsDest.Cells(rng.Value, 23) = "" Then
        wsDest.Cells(rng.Value, 23) = rng.Offset(, 2).Value
    ElseIf wsDest.Cells(rng.Value, 24) = "" Then
        wsDest.Cells(rng.Value, 24) = rng.Offset(, 2).Value
    ElseIf wsDest.Cells(rng.Value, 25) = "" Then
        wsDest.Cells(rng.Value, 25) = rng.Offset(, 2).Value
    End If

    Next rng

End Sub

Display More

Hope someone helps me.

Thanks in advance.

**KjBox** · Sep 11th 2021

Try changing

Code

wsDest.Range("A1").Value = ""

to

Code

wsDest.UsedRange.Clear

mamun.ges · Sep 11th 2021

When Row changed

It cleared the previously used range.

I want the previous row unchanged if the row changes.

If the row is unchanged but data changed then clear the data and impose the current data

and If nothing changes then Nothing.

Hope you understand.

Suggestion Please?

Thanks Again

mamun.ges · Sep 11th 2021

Hi, I am trying to update the code but faild in one place that is,

If the cell is blank data copy & paste but if data exist then it is note overwrite the existing data or do not update.

Check this & the recommended.

Code

Sub Update()

Dim wsSource As Worksheet: Set wsSource = Sheets("Source")
Dim lastrow As Long: lastrow = wsSource.Cells(Rows.Count, 1).End(xlUp).Row
Dim wsDest As Worksheet: Set wsDest = Sheets("Dest")
Dim rngRows As Range: Set rngRows = wsSource.Range("A2:A4")
Dim rng As Range
Dim Response As Integer

Response = MsgBox("Are you sure you want Update?", vbYesNo, "Update")

wsDest.Range("A1").Value = vbNullString

For Each rng In rngRows
    If rng = Value Then
    rng = rng
    
    ElseIf Response = vbYes And wsDest.Cells(rng.Value, 23) = Value Then
    wsDest.Cells(rng.Value, 23).Clear
    wsDest.Cells(rng.Value, 23) = rng.Offset(, 2).Value
    ElseIf Response = vbYes And wsDest.Cells(rng.Value, 24) = Value Then
    wsDest.Cells(rng.Value, 24).Clear
    wsDest.Cells(rng.Value, 24) = rng.Offset(, 2).Value
    ElseIf Response = vbYes And wsDest.Cells(rng.Value, 25) = Value Then
    wsDest.Cells(rng.Value, 25).Clear
    wsDest.Cells(rng.Value, 25) = rng.Offset(, 2).Value
    
    Else
    'do nothing
    End If
    
    Next rng
    

End Sub

Display More

**KjBox** · Sep 11th 2021

Try

Code

Sub Update()
    Dim wsSource As Worksheet: Set wsSource = Sheets("Source")
    Dim wsDest As Worksheet: Set wsDest = Sheets("Dest")
    Dim rngRows As Range: Set rngRows = wsSource.Range("A2:A4")
    Dim r As Range,i as Long, ii as Long, iii as Long
    
    For Each r In wsSource.Range("A2:A4")
        If r <> "" Then
            i = r: ii = r.Offset(, 2)
            For iii = 23 To 25
                wsDest.Cells(i, iii) = ii
            Next
        End If
    Next

End Sub

Display More

If that does not produce the required result then you will need to attach your workbook and show expected result.

mamun.ges · Sep 11th 2021

Hi, Kj box,

It Workes perfectly. Thanks.

If there is a possible response option that could be much better for me.

Response = MsgBox("Are you sure you want to update?", vbYesNo, "Update?")

If Yes then update, otherwise nothing happens.

If it's possible in your code will be much better.

Thanks for the work you have done for me.

mamun.ges · Sep 11th 2021

I have done the above requirements, Thanks for the support.

Code

Sub Update()
 Dim wsSource As Worksheet: Set wsSource = Sheets("Source")
 Dim wsDest As Worksheet: Set wsDest = Sheets("Dest")
 Dim rngRows As Range: Set rngRows = wsSource.Range("A2:A4")
 Dim r As Range, i As Long, ii As Long, iii As Long
 Dim Response As Integer

    Response = MsgBox("Do you want to Update?", vbYesNo, "Update?")
    If Response = vbYes Then
    For Each r In wsSource.Range("A2:A4")
    If r <> "" Then
    i = r: ii = r.Offset(, 2)
    For iii = 23 To 25
    wsDest.Cells(i, iii) = ii
    Next
    End If
    Next
    
    Else
    'do nothing
    End If


End Sub

Display More

Thanks and keep supporting us.

mamun.ges · Sep 11th 2021

When I want to change something in your code then this message showing.

Can you tell me what is the problem?

Then code is not working correctly.

mamun.ges · Sep 11th 2021

Hi, There may some problem with your code.

It copies only the 3rd cell and paste 3rd cell data to 23 to 25.

Sorry to say,

What happened. It becomes simple to complex.

mamun.ges · Sep 11th 2021

Please Kjbox See the above post

I am attaching the sample file Sample.xlsm for your kind support.

Thanks again

**KjBox** · Sep 11th 2021

Try

Code

Sub Update()
    Dim x, wsDest As Worksheet: Set wsDest = Sheets("Destination")
    
    If MsgBox("Do you want to Update?", vbYesNo, "Update?") = vbYes Then
        If [a10] <> "" Then
            x = [a10].Offset(, 1).Resize(3)
            wsDest.Cells([a10], 23).Resize(, 3) = Application.Transpose(x)
        End If
        MsgBox "Updated", , "Update?"
    End If
    
End Sub

Display More

mamun.ges · Sep 12th 2021

Thank You So Much Kjbox.

Good Work.

With best regards.

**KjBox** · Sep 12th 2021

You're welcome

VBA Code Modification, Command button to copy data based on row number.

Participate now!

Share