VBA to find a value and replace number of associated parameters

[Dervos]

Hello Experts,

Seeking your wisdom once again...

I am trying to come up with a VBA which would - take a Value from a cell, look for it in another sheet, and replace a number of cell values associated with that Value.

Here's an example with some dummy data:

- There are a number of Names in a dropdown in Sheet 1 called New Records. I select John.
- John has a number of Car 1 / Car 2 / Car 3 and Laptop / PC / Tablet items associated with him:



- Sheet 2 called Old Records is used as a storage where John's (and other people) records are stored:



Now...knowing that there are over 200 name records, and over 117 columns (i.e. Car1 Car2 Car3 etc...) in Sheet 2 (Old Records) - what is the best way to update Sheet 2 (Old Records) row values with new values from Sheet1 (New Records) based on a Name Value?


Appreciate your help!

 

[JLGWhiz]

Hi Devros, you have presented a scenario where many decisisions would need to be made but have provided very little in the way of criteria that would be used to make those decisions logically.
1. Under what condition would you replace car 1, car 2, or car 3?
2. Under what condition would you replace Laptop or PC or Tablet.
3. Do you want to just add an item to old records but replace the item in the current data sheet?
4. Is the example how you currently have the database designed for each sheet?
5. Do you want changes to occur based on a user input as the event occurs or do you want the user to use a button to execute code.
6. Have you tried anything on the project to date, and if so, can you post what you have done?
There are some really sharp people who respond to posts on this forum, but my experience is that they are not very good at ESP, so the more you can reveal the better the response.

 

[DanteAmor]

If your data is like this on your sheets:

<table style="font-family:Arial; font-size:12pt; border-style: groove ;border-color:#0000FF;background-color:#fffcf9; color:#000000; "><tr><td ><b>Sheet1</b></td></tr></table><table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td >Name</td><td >John</td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td > </td><td >Amount</td><td > </td><td > </td><td >Amount</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td style="background-color:#ff0000; color:#ffff00; ">Car1</td><td style="text-align:right; ">1</td><td > </td><td style="background-color:#ff0000; color:#ffff00; ">Laptop</td><td style="text-align:right; ">4</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td style="background-color:#ff0000; color:#ffff00; ">Car2</td><td style="text-align:right; ">2</td><td > </td><td style="background-color:#ff0000; color:#ffff00; ">PC</td><td style="text-align:right; ">1</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td style="background-color:#ff0000; color:#ffff00; ">Car3</td><td style="text-align:right; ">2</td><td > </td><td style="background-color:#ff0000; color:#ffff00; ">Tablet</td><td style="text-align:right; ">1</td></tr></table>


<table style="font-family:Arial; font-size:12pt; border-style: groove ;border-color:#0000FF;background-color:#fffcf9; color:#000000; "><tr><td ><b>Sheet2</b></td></tr></table><br /><table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td><td >F</td><td >G</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td >Name</td><td >Car1</td><td >Car2</td><td >Car3</td><td >Laptop</td><td >PC</td><td >Tablet</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td >John</td><td style="text-align:right; ">1</td><td style="text-align:right; ">2</td><td style="text-align:right; ">2</td><td style="text-align:right; ">4</td><td style="text-align:right; ">1</td><td style="text-align:right; ">1</td></tr></table>


Try with the following macro, update the data in red for your information

Option Explicit
Sub replace_number()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim wName As String, c As Range, f As Range, r As Long
    
    Set sh1 = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
    Set sh2 = Sheets("[COLOR=#ff0000]Sheet2[/COLOR]")
    
    wName = sh1.Range("[COLOR=#ff0000]B1[/COLOR]")     'cell with name
    Set f = sh2.Range("A:A").Find(wName, LookIn:=xlValues, lookat:=xlWhole)
    If Not f Is Nothing Then
        r = f.Row
        For Each c In sh1.Range("[COLOR=#ff0000]A4:A10,D4:D10[/COLOR]")   'range of cells with the names of the columns
            If c.Value <> "" Then
                Set f = sh2.Rows(1).Find(c.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not f Is Nothing Then
                    sh2.Cells(r, f.Column).Value = c.Offset(0, 1).Value
                End If
            End If
        Next
    Else
        MsgBox "The name does not exist"
    End If
End Sub

 

[Dervos]

JLGWhiz,

Thanks for great questions!

To be honest - there really aren't any logical conditions. The challenge is to simply copy/paste the data from Sheet 1 to Sheet 2 to the correct fields(Car 1 to Car 1, Car 2 to Car 2 etc...) based on a Name value.

This should be initiated by a Button, which should also check if any Name Value has been selected (else throw an error).

Hope this makes sense!

 

[DanteAmor]

It would help if you put exactly where the data is on sheet1, and where you have the titles on sheet2.
But you can change the data in the macro that I gave you.
Let me know if you have any questions.

 

[Dervos]

DanteAmor,

This is exactly what i was looking for!

Thanks a lot for your help. Much appreciated!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.