Match sheet name for cell with sheet name and repeat filling blank cells

Mussala

Board Regular
Joined
Sep 28, 2022
Messages
61
Office Version
  1. 2019
Platform
  1. Windows
Hi experts,
I have multiple sheets in my file , but I want loop throughout theses sheets(mst,secv,thr) based on matching cell H6 with MATCH sheet .
so should search for matched sheet name with cell H6 if it's matched , then should fill blank cells & repeat them for columns B,C,D based on cells J9,N8,S7 where are existed in MATCH sheet .
if there columns B,C,D are already filled, then should ignore columns B,C,D are filled , just search for next blank cells in column B,C, and fill them.
I have this code for @Peter_Ss but this work for just one sheet.
VBA Code:
Sub Fill_Values_v2()
  Dim ws2 As Worksheet
  Dim lrC As Long, lrD As Long
 
  Set ws2 = Sheets("Sheet2")
  With Sheets("Sheet1")
    lrC = .Range("A" & Rows.Count).End(xlUp).Row
    lrD = .Range("B" & Rows.Count).End(xlUp).Row
    If lrC > lrD Then
      With .Range("B" & lrD + 1 & ":D" & lrC)
        .Value = Array(ws2.Range("J9").Value, ws2.Range("S7").Value, ws2.Range("N8").Value)
      End With
    End If
  End With
End Sub
original data
Microsoft Excel .xlsx
ABCDE
1ITEMNAMEDATEREF NOBRAND
21BFGH-001
32BFGH-002
43BFGH-003
54BFGH-004
65BFGH-005
76BFGH-006
87BFGH-007
98BFGH-008
109BFGH-009
1110BFGH-010
mst


Microsoft Excel.xlsx
ABCDE
1ITEMNAMEDATEREF NOBRAND
21BFGH-0110
32BFGH-0111
43BFGH-0112
54BFGH-0113
65BFGH-0114
76BFGH-0115
87BFGH-0116
secv



Microsoft Excel.xlsx
ABCDE
1ITEMNAMEDATEREF NOBRAND
21BFGH-0011
32BFGH-0012
43BFGH-0013
54BFGH-0014
65BFGH-0015
thr


Microsoft Excel .xlsx
HIJKLMNOPQRS
5SHEET NAME
6DATE
7REF NO
8NAME
9
MATCH


example and result for sheet mst
Microsoft Excel .xlsx
HIJKLMNOPQRS
4
5SHEET NAME
6mstDATE
7REF NO10/04/2023
8NAMERE-001
9MUSSA
MATCH
Cell Formulas
RangeFormula
S7S7=TODAY()


should be
Microsoft Excel .xlsx
ABCDE
1ITEMNAMEDATEREF NOBRAND
21MUSSA10/04/2023RE-001BFGH-001
32MUSSA10/04/2023RE-001BFGH-002
43MUSSA10/04/2023RE-001BFGH-003
54MUSSA10/04/2023RE-001BFGH-004
65MUSSA10/04/2023RE-001BFGH-005
76MUSSA10/04/2023RE-001BFGH-006
87MUSSA10/04/2023RE-001BFGH-007
98MUSSA10/04/2023RE-001BFGH-008
109MUSSA10/04/2023RE-001BFGH-009
1110MUSSA10/04/2023RE-001BFGH-010
mst


another example for sheet thr
Microsoft Excel .xlsx
HIJKLMNOPQRS
5SHEET NAME
6thrDATE
7REF NO10/04/2023
8NAMETH-001
9MUSTAFA
MATCH
Cell Formulas
RangeFormula
S7S7=TODAY()

should be
Microsoft Excel .xlsx
ABCDE
1ITEMNAMEDATEREF NOBRAND
21MUSTAFA10/04/2023TH-001BFGH-0011
32MUSTAFA10/04/2023TH-001BFGH-0012
43MUSTAFA10/04/2023TH-001BFGH-0013
54MUSTAFA10/04/2023TH-001BFGH-0014
65MUSTAFA10/04/2023TH-001BFGH-0015
thr
 
Last edited:
In fact: you don't even need the code that checks if the sheet exists and creates it if it doesn't.
ok but maybe shows error if the sheet name is not matched ,then should show "message the sheet is not existed".
 
Upvote 0

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Try with:

VBA Code:
Sub Fill_Values_v3()
Dim ws As Worksheet, mData, C As Range, D As Range
Application.ScreenUpdating = False
'------------------>
With Sheets("Match")
  If IsError(Evaluate("Cell(""Row"", " & .Range("A3") & "!A1)")) Then MsgBox "The sheet does not exist.": Exit Sub
  Set ws = Sheets(CStr(.Range("A3"))): ws.Activate
  mData = Array(.[c6].Value, .[L4].Value, .[g5].Value)
End With
'------------------>
Set C = ws.Cells(Rows.Count, "B").End(xlUp)
Set D = ws.Cells(Rows.Count, "E").End(xlUp)
If C.Row = D.Row Then MsgBox "There are no cells to fill.": Exit Sub
'------------------>
ws.Range(C(2), D(, 0)) = mData
ws.Range("A2") = 1: ws.Range("A2:A" & D.Row).DataSeries
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,215,221
Messages
6,123,699
Members
449,117
Latest member
Aaagu

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