Take Region, Find Right Sheet, Find Right Sub, Copy Update to Right Row

Nlhicks

Active Member
Joined
Jan 8, 2021
Messages
264
Office Version
  1. 365
Platform
  1. Windows
I need to look at Region "C17:C23" and then go to the right region sheet "MMO, NDMO, SDMO" and then look at the right station "D17:D23") and find it on the right sheet then copy and past the information entered in cells "E17:M23".


Arc Flash Tracking.xlsm
BCDEFGHIJKLMNOP
14
15STOPSTOP
16RegionSubstationDate StickeredStickered ByField Comments
17MMOBole
18
19
20
21
22
23
Updates


Arc Flash Tracking.xlsm
ABCDEFGHIJKLMN
1SUBSTATIONLAST DONEDONE BYDUE DATENOTES
2Bole2024N. Hicks2029
3Circle2024N. Hicks2029
4Conrad2024N. Hicks2029
5Crossover2024N. Hicks2029
6Custer2024N. Hicks2029
7Dawson County2024N. Hicks2029Updated model, there were lots of errors on this model.
8Fairview West2024N. Hicks2029
9Fort Peck2024N. Hicks2029Working with Coop to get source impedances for Fort Peck (Nor Val)
MMO
Cells with Conditional Formatting
CellConditionCell FormatStop If True
D2:D30Cell Value>TODAY()-B2>1825textNO
D2:D30Cell Valuebetween TODAY()-B2>=1460 and TODAY()-B2>=1825textNO
D2:D30Cell Valuebetween B2 and TODAY()+1460textNO


Arc Flash Tracking.xlsm
ABCDEFGHIJKLMN
1SUBSTATIONLAST DONEDONE BYDUE DATENOTES
2BelfieldCould not label due to Construction project blocking access, still needs to be done
3Bisbee2022T. McCready
4Bismarck2022T. McCreadyModel is 99% done, waiting on Fuse verification from NDMO, have email string in folder, needs labeled still
5Cambell County
6Carrington
7Custer Trail
8Denbeigh
9Devaul2022T. McCreadyNew Station service transformer to be install poss. 2024/25, new xfmr info is in folder in email string. No cell service at sub, very remote, verify location prior to driving out
10Devils Lake2022T. McCready
11Edgeley2023T. McCready
NDMO



Arc Flash Tracking.xlsm
ABCDEFGHIJKLMN
1SUBSTATIONLAST DONEDONE BYDUE DATENOTES
2Appledorn2020E. Ayoroa2025
3Armour2024N. Hicks2029Slight change to 0050 drawing, no change to 0051. Need to update Easy Power Model.
4Aurora2024N. Hicks2029Breaker added to 0051 Rev A and sent to April Rigge to draft. Need to update the Easy Power Model
5Beresford2022T. McCready2028Labeled prior to updating WAPA policy. Valid labels, but need updated for WAPA Policy
6Bonesteel2024N. Hicks2029
7Brookings
8Carpenter2023T. McCready2028East River Project work here 2025ish No PM yet
9Creston
10Denison
SDMO
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Try This
=IFERROR(VLOOKUP(C4,INDIRECT(B4&"!A:L"),2,0),"")
 

Attachments

  • lookup.JPG
    lookup.JPG
    63.2 KB · Views: 9
Upvote 0
Try This
=IFERROR(VLOOKUP(C4,INDIRECT(B4&"!A:L"),2,0),"")
Thank you so Much Rajesh, I am looking more for a macro that will Look on the Master File under Column C, get the value, then go to the right sheet, in this case MMO, Find the right value from column D in Column A of the MMO sheet and if found paste the values from Column E:F of the master in the proper place in the MMO folder.
 
Upvote 0
Here is a repost of the sheets with updated titles that acutually match. This should help.


Arc Flash Tracking.xlsm
ABCDEFGHIJKLMNOPQR
12
13
14
15STOPSTOP
16RegionSubstationDate StickeredStickered ByField Comments
17MMOBole2026J. PhelpsOne sticker remaining, will mail
18MMOCuster2026M.Mouse
19MMOShelby2026D.Duck
20MMOMiles City2026GoofyUpdated the converter station, many transformers without labels, Acid panel added, SSs added
21MMOCrossover2026Pluto
22
23
24
25
26
Updates



Arc Flash Tracking.xlsm
ABCDEFGHIJKLMN
1SubstationDate StickeredStickered ByDue DateField Comments
2Bole2024N. Hicks2029
3Circle2024N. Hicks2029
4Conrad2024N. Hicks2029
5Crossover2024N. Hicks2029
6Custer2024N. Hicks2029
7Dawson County2024N. Hicks2029Updated model, there were lots of errors on this model.
MMO
Cells with Conditional Formatting
CellConditionCell FormatStop If True
D2:D30Cell Value>TODAY()-B2>1825textNO
D2:D30Cell Valuebetween TODAY()-B2>=1460 and TODAY()-B2>=1825textNO
D2:D30Cell Valuebetween B2 and TODAY()+1460textNO
 
Upvote 0
Here is where I am so far
Sub Updates()

Excel Formula:
Dim lookUpSheet As Worksheet, updateSheet As Worksheet
Dim valueToSearch As String
Dim RF As Integer, MF As Integer
Dim RangeToCopy As String
Dim DS As Integer
Dim SB As Variant
Dim FC As Variant

'Dim instock As Integer

'RF is the Region File (MMO), MF is the Master File


Set lookUpSheet = Worksheets("Updates")
Set updateSheet = Worksheets("MMO")

'get the number of the last row with data in MMO and in Updates

    LastRowLookup = lookUpSheet.Cells(Rows.Count, "D").End(xlUp).Row
    MsgBox (lookUpSheet.Cells(Rows.Count, "D").End(xlUp).Row)
    lastRowUpdate = updateSheet.Cells(Rows.Count, "A").End(xlUp).Row
    MsgBox (updateSheet.Cells(Rows.Count, "A").End(xlUp).Row)
    
'for every value in column D of Updates
    For MF = 17 To LastRowLookup
        For DS = 17 To LastRowLookup
            For SB = 17 To LastRowLookup
                For FC = 17 To LastRowLookup
                
         valueToSearch = lookUpSheet.Cells(MF, 4)
         valueToSearch = lookUpSheet.Cells(DS, 5)
         valueToSearch = lookUpSheet.Cells(SB, 6)
         valueToSearch = lookUpSheet.Cells(FC, 7)
         'look for the value in column A of MMO
        MsgBox (lookUpSheet.Cells(MF, 4))
        MsgBox (lookUpSheet.Cells(DS, 5))
        MsgBox (lookUpSheet.Cells(SB, 6))
        MsgBox (lookUpSheet.Cells(FC, 7))
         For RF = 1 To lastRowUpdate
            'if found a match, copy column A value to Updates and proceed to the next value
            If updateSheet.Cells(RF, 1) = valueToSearch Then
                updateSheet.Cells(RF, 2).Value = DS.Value
                
    '            Set newstock = lookUpSheet.Cells(mm, 8)
    '            Set instock = updateSheet.Cells(tt, 12)
    '            updateSheet.Cells(tt, 12).Value = newstock + instock
       '         updateSheet.Cells(RF, 2).Value = "IRATA"
                Exit For
            End If
                    Next RF
                Next DS
            Next SB
        Next FC
        
    Next MF

End Sub
[CODE=xls]
[/CODE]
 
Upvote 0
I got this to work for the first case of "MMO" but now it needs to distinguish between "MMO", "SDMO" and "NDMO" and make sure it goes to the right one
Excel Formula:
Sub Updates()

    Dim lookUpSheet As Worksheet, updateSheet As Worksheet
    Dim valueToSearch As String
    Dim RF As Integer, MF As Integer
    Dim RangeToCopy As String
    Dim DS As Integer


    Set lookUpSheet = Worksheets("Updates")
    Set updateSheet = Worksheets("MMO")


'get the number of the last row with data in MMO and in Updates

    LastRowLookup = lookUpSheet.Cells(Rows.Count, "D").End(xlUp).Row

    MsgBox (lookUpSheet.Cells(Rows.Count, "D").End(xlUp).Row)
    lastRowUpdate = updateSheet.Cells(Rows.Count, "A").End(xlUp).Row
    MsgBox (updateSheet.Cells(Rows.Count, "A").End(xlUp).Row)
    
'for every value in column D of Updates
    For MF = 17 To LastRowLookup

                
         valueToSearch = lookUpSheet.Cells(MF, 4)

'         'look for the value in column A of MMO

         For RF = 1 To lastRowUpdate
            'if found a match, copy column A value to Updates and proceed to the next value
            If updateSheet.Cells(RF, 1) = valueToSearch Then
               updateSheet.Cells(RF, 2).Value = lookUpSheet.Cells(MF, 5)
               updateSheet.Cells(RF, 3).Value = lookUpSheet.Cells(MF, 6)
               updateSheet.Cells(RF, 7).Value = lookUpSheet.Cells(MF, 7)
                

                Exit For
            End If
        Next RF
    Next MF

End Sub
 
Upvote 0
Sub Lookup_sheet()
Dim ws As Worksheet
Dim lastrow As Long
Dim x, i As Integer
Set ws = ThisWorkbook.Sheets("Updates")
ws.Activate
lastrow = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
Range(Cells(6, 5), Cells(lastrow, 8)).UnMerge
Range(Cells(6, 5), Cells(lastrow, 8)).ClearContents
sheetcount = ActiveWorkbook.Sheets.Count


For x = 6 To lastrow
Dim sh As String
Dim fnd As String
Dim foundCell As Range
sh = ws.Range("C" & x).Value
fnd = ws.Range("D" & x).Value
ws.Range("D" & x).Copy
Sheets(sh).Select
Columns("A:A").Select

Set foundCell = Selection.find(What:=fnd, After:=ActiveCell, LookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not foundCell Is Nothing Then
foundCell.Activate
ActiveCell.Offset(0, 1).Select
Dim data1 As Range
Dim data2 As Range
Set data1 = Range(Selection, ActiveCell.Offset(0, 1))
Set data2 = ActiveCell.Offset(0, 3)
Application.CutCopyMode = False
'Selection.UnMerge
data1.Copy
ws.Activate
Range("E" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues

data2.Copy
ws.Activate
Range("G" & x).Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("G" & x, "M" & x).Merge
Else
End If
Next x



End Sub
 
Upvote 0
Solution
Thanks Raj,

This actually works exactly like I need it to, except: If I misspell a work on the matching part then it does nothing. Is there a way to fix the matching part so that it will find the closes match possible without it being spelled exactly right?

VBA Code:
Sub Updates()

    Dim lookUpSheet As Worksheet, updateSheet As Worksheet, updateSheet2 As Worksheet, updateSheet3 As Worksheet
    Dim valueToSearch As String
    Dim RF As Integer
    Dim RangeToCopy As String
    Dim DS As Integer


    Set lookUpSheet = Worksheets("Updates")
    Set updateSheet = Worksheets("MMO")
    Set updateSheet1 = Worksheets("NDMO")
    Set updateSheet2 = Worksheets("SDMO")

'get the number of the last row with data in MMO and in Updates

    LastRowLookup = lookUpSheet.Cells(Rows.Count, "D").End(xlUp).Row
    MsgBox (lookUpSheet.Cells(Rows.Count, "D").End(xlUp).Row)
    LastRowUpdate = updateSheet.Cells(Rows.Count, "A").End(xlUp).Row
    MsgBox (updateSheet.Cells(Rows.Count, "A").End(xlUp).Row)
    LastRowUpdate1 = updateSheet1.Cells(Rows.Count, "A").End(xlUp).Row
    MsgBox (updateSheet1.Cells(Rows.Count, "A").End(xlUp).Row)
    LastRowUpdate2 = updateSheet2.Cells(Rows.Count, "A").End(xlUp).Row
    MsgBox (updateSheet2.Cells(Rows.Count, "A").End(xlUp).Row)
    
'for every value in column D of Updates
    For MF = 17 To LastRowLookup
                
         valueToSearch = lookUpSheet.Cells(MF, 4)

'         'look for the value in column A of MMO

         For RF = 1 To LastRowUpdate
            'if found a match, copy column A value to Updates and proceed to the next value (MMO)
            If updateSheet.Cells(RF, 1) = valueToSearch Then
               updateSheet.Cells(RF, 2).Value = lookUpSheet.Cells(MF, 5)
               updateSheet.Cells(RF, 3).Value = lookUpSheet.Cells(MF, 6)
               updateSheet.Cells(RF, 7).Value = lookUpSheet.Cells(MF, 7)
                Exit For
            End If
        Next RF
            For RF = 1 To LastRowUpdate1
            'if found a match, copy column A value to Updates and proceed to the next value (NDMO)
                If updateSheet1.Cells(RF, 1) = valueToSearch Then
                    updateSheet1.Cells(RF, 2).Value = lookUpSheet.Cells(MF, 5)
                    updateSheet1.Cells(RF, 3).Value = lookUpSheet.Cells(MF, 6)
                    updateSheet1.Cells(RF, 7).Value = lookUpSheet.Cells(MF, 7)
                Exit For
            End If
        Next RF
                    
                For RF = 1 To LastRowUpdate2
                'if found a match, copy column A value to Updates and proceed to the next value (SDMO)
                    If updateSheet2.Cells(RF, 1) = valueToSearch Then
                        updateSheet2.Cells(RF, 2).Value = lookUpSheet.Cells(MF, 5)
                        updateSheet2.Cells(RF, 3).Value = lookUpSheet.Cells(MF, 6)
                        updateSheet2.Cells(RF, 7).Value = lookUpSheet.Cells(MF, 7)

                Exit For
            End If
        Next RF

    Next MF

End Sub
 
Upvote 0
just give me example with such scenarios and the output you need.
 
Upvote 0

Forum statistics

Threads
1,224,818
Messages
6,181,152
Members
453,021
Latest member
Justyna P

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