VBA Macro: Lookup Word, Copy Cell, Lookup Word (next tab), Paste Copied Value

mwayne021

New Member
Joined
Mar 3, 2016
Messages
3
I'm looking for a Macro to run that will lookup "Project #" in Sheet 1 (named ProjectID), copy its adjacent cell value on the right, look for every time the word "Project #" appears in the remaining sheets and paste the previously copied value into the adjacent cell on the right.

[e.g. Project # is in the ProjectID tab, cell C4 with "100" in D4. "Project #" appears on each remaining sheets multiple times in varying cells (such as L4, A56, BZ60, etc.) and want "100" to appear in the cell to the right on those remaining sheets.]



I'm looking for this to run for multiple lookup fields: "Project #", "Project", "Computed By", "Checked By", "Sheet No", "Subject", and two "Date" fields (I figured these could be differentiated using a space at the end?)

There are six worksheets for the script to run through: "Building & Loads", "Areas", "Live Loads", "Foundation_LoadFactor_1", "Foundation_LoadFactor_0.6_0.7", "Foundation_LoadFactor_0.45_0.52"

The premise is I have a project full of calculations that I need to print to pdf. To make the Excel calcs match the hand clacs, I created a "header" in the upper most rows of each page break to mimic the one on the stationary. Instead of pasting or referencing the project number and date, etc. by hand - I just went everything to auto populate. In total, there are 61 PDF pages, so you can see why I don't want to go in and reference cells.

I have an additional question that I will be posting in a separate post also, but I'm also looking for a VBA that will calculate and return value of the current page number and then the total number of printed pages in the entire workbook so I can add "PageNum. of Total Printed PDF Pages" in the header field as well.
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Welcome to the board. Try:
Code:
Sub Replace_v1()

    Dim var     As Variant
    Dim rng     As Range
    Dim ws      As Worksheet
    
    Application.ScreenUpdating = False

    For Each var In Array("Project #", "Project", "Computer By", "Checked By", "Sheet No", "Subject")
        For Each ws In ActiveWorkbook.Worksheets
            With ws
                On Error Resume Next
                If .Name = "ProjectID" Then
                    Set rng = .Cells.find(what:=var, LookIn:=xlValues, lookat:=xlWhole).Offset(, 1)
                Else
                    .Cells.find(what:=var, LookIn:=xlValues, lookat:=xlWhole).Offset(, 1).value = rng.value
                End If
                On Error GoTo 0
            End With
            If Not rng Is Nothing Then Set rng = Nothing
        Next ws
    Next var
        
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
Thanks for such a quick reply! I'm not sure why, but it doesn't appear to run at all. I do have other macros in the sheet, so I don't know if I'm missing something...?

Welcome to the board. Try:
Code:
Sub Replace_v1()

    Dim var     As Variant
    Dim rng     As Range
    Dim ws      As Worksheet
    
    Application.ScreenUpdating = False

    For Each var In Array("Project #", "Project", "Computer By", "Checked By", "Sheet No", "Subject")
        For Each ws In ActiveWorkbook.Worksheets
            With ws
                On Error Resume Next
                If .Name = "ProjectID" Then
                    Set rng = .Cells.find(what:=var, LookIn:=xlValues, lookat:=xlWhole).Offset(, 1)
                Else
                    .Cells.find(what:=var, LookIn:=xlValues, lookat:=xlWhole).Offset(, 1).value = rng.value
                End If
                On Error GoTo 0
            End With
            If Not rng Is Nothing Then Set rng = Nothing
        Next ws
    Next var
        
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
It worked fine for me on a test spreadsheet I mocked up.. maybe you need ProjectID sheet to be the very first sheet? I modified the code, try:
Code:
Sub Replace_v1()

    Dim var     As Variant
    Dim rng     As Range
    Dim ws      As Worksheet
    
    Dim wsPID   As Worksheet
    Set wsPID = Sheets("ProjectID")
    
    Application.ScreenUpdating = False

    For Each var In Array("Project #", "Project", "Computer By", "Checked By", "Sheet No", "Subject")
        Set rng = wsPID.Cells.find(what:=var, LookIn:=xlValues, lookat:=xlWhole).Offset(, 1)
        
        For Each ws In ActiveWorkbook.Worksheets
            With ws
                On Error Resume Next
                If .Name <> wsPID.Name Then
                    .Cells.find(what:=var, LookIn:=xlValues, lookat:=xlWhole).Offset(, 1).value = rng.value
                End If
                On Error GoTo 0
            End With
        Next ws
        
        Set rng = Nothing
    Next var
        
    Application.ScreenUpdating = True
    
End Sub
 
Last edited:
Upvote 0
That works perfectly, Thank you so much!

It worked fine for me on a test spreadsheet I mocked up.. maybe you need ProjectID sheet to be the very first sheet? I modified the code, try:
Code:
Sub Replace_v1()

    Dim var     As Variant
    Dim rng     As Range
    Dim ws      As Worksheet
    
    Dim wsPID   As Worksheet
    Set wsPID = Sheets("ProjectID")
    
    Application.ScreenUpdating = False

    For Each var In Array("Project #", "Project", "Computer By", "Checked By", "Sheet No", "Subject")
        Set rng = wsPID.Cells.find(what:=var, LookIn:=xlValues, lookat:=xlWhole).Offset(, 1)
        
        For Each ws In ActiveWorkbook.Worksheets
            With ws
                On Error Resume Next
                If .Name <> wsPID.Name Then
                    .Cells.find(what:=var, LookIn:=xlValues, lookat:=xlWhole).Offset(, 1).value = rng.value
                End If
                On Error GoTo 0
            End With
        Next ws
        
        Set rng = Nothing
    Next var
        
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
You're welcome, but you may want to acknowledge skywriter's help in the other forum and take note that cross-posting is selfish and generally frowned upon, unless you explicitly state you've cross posted with links to the other site in your thread.
 
Upvote 0
Thank you JackDanIce

mwayne021 If you happen to read this no one has been anything but courteous to you in trying to point out the issues with cross posting.

The link I sent you to regarding cross posting is written very nicely and even states that no one is mad at you, we are disappointed in your cross posting and would hope to educate you.

Your extremely rude comment in post #9, on the other board is uncalled for. If you don't respect the knowledge that people are willing to share with you free of charge maybe you should just hire someone.

You're welcome, but you may want to acknowledge skywriter's help in the other forum and take note that cross-posting is selfish and generally frowned upon, unless you explicitly state you've cross posted with links to the other site in your thread.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,215,020
Messages
6,122,709
Members
449,093
Latest member
Mnur

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top