Maro Required - Fill in texts in cells based on other cell values

[Blaster1]

Hi Guys,

I am new here and want a MACRO help.
I want to use a MACRO code to be applied to ALL Worksheets within one workbook.

If cells A2 (as an example) containts text (any text) then fill in B2 with "John Smith" C2 with date "12 09 21" and D2 with "John Smith" but with special font (MISTRAL Font).
I want this to be applied for all rows associated with column range A2:A11 (when there is not text in a any cell of range A2:A11 like A6 in below image, then do nothing) then applies it to all worksheets in the workbook.
Thanks.

 

[Blaster1]

Looks like I am unable to complete my code without your help ...
I still have two things to complete:

1- See below table ... I am trying to delete all rows that have "Zone Noo" in Column A HOWEVER, I want to KEEP rows that have "Zone Noo" in Column A AND "Zone ABC" or "Zone XYZ" in column F .... so by applying the code, I should end up having rows 1 to 10 intact and then two more rows with Zone Noo (one row with Zone ABC + one row with Zone XYZ). Also if possible I want to lock the column width as Columns A, B, C : ColumnWidth 20; Columns D, E, F: ColumnWidth 25; Columns G, H ColumnWidth 18.

Column A	Column B	Column C	Column D	Column E	Column F	Column G	Column H
Yes						State
A	B	Text1	Test2	Text	test	Y	N
1	a				a
2	b				a
3	a				a
4	b				a
5	a				a
6	b				a
7	a				a
8	b				a
9	a				a
10	b				a
Zone Noo	100	1	Zone ABC	L89-FCU-02-RM-T	Zone ABC
Zone Noo	100	1			1
Zone Noo	100	1		r	2
Zone Noo	100	1		r	3
Zone Noo	100	1	Zone YYY		Zone XYZ
Zone Noo	100	2		r	rr
Zone Noo	100	2			4
Zone Noo	100	2			5
Zone Noo	100	2	r	r	a
Zone Noo	100	3			d
Zone Noo	100	3	r		f
Zone Noo	100	3	r		r
Zone Noo	100	r			e

2- Need more time to generate the second query as it is bit complicated. Basically a macro to create one workbook with multiple worksheets (that have special formatted table) inside it based on another workbook data ... will provide more info soon.

Can't Thank You Enough .

 

[Peter_SSs]

1- See below table ... I am trying to delete all rows that have "Zone Noo" in Column A HOWEVER, I want to KEEP rows that have "Zone Noo" in Column A AND "Zone ABC" or "Zone XYZ" in column F ....

1. Is this an additional task for the earlier macro or is this a stand-alone job/code?

2. Can you confirm that the actual data now starts in row 7, not row 5 like it was earlier?

2- Need more time to generate the second query as it is bit complicated. Basically a macro to create one workbook with multiple worksheets (that have special formatted table) inside it based on another workbook data ... will provide more info soon.

If it is a separate question, then you should start a new thread for it.

 

[Blaster1]

1. Is this an additional task for the earlier macro or is this a stand-alone job/code?

2. Can you confirm that the actual data now starts in row 7, not row 5 like it was earlier?



If it is a separate question, then you should start a new thread for it.

1. Hi, Yes it is an additional task for the earlier macro .. I have a big code now that I am embedding new ones to it... apologies, the actual data will start at row 5 like earlier.

2. I will start new thread for the other query

 

[Peter_SSs]

Yes it is an additional task for the earlier macro ..

Try this. Note that this structure will only work for two values that you want to keep in column F. If more are to be added then a significant change of approach would be needed.

BTW, how big (number of rows) is your actual data?

Sub FillValues_v4()
  Dim ws As Worksheet
  Dim a(1 To 3) As Variant

  a(1) = "John Smith":  a(2) = DateSerial(2021, 12, 9): a(3) = a(1)
  For Each ws In Worksheets
    With ws.Range("A4:F" & ws.Range("A" & Rows.Count).End(xlUp).Row)
      .AutoFilter Field:=2, Criteria1:=Array("ABC", "KLM", "XYZ", "ZYX"), Operator:=xlFilterValues
      If .Columns(1).SpecialCells(xlVisible).Count > 1 Then .Offset(1).EntireRow.Delete
      .AutoFilter Field:=2
      .AutoFilter Field:=1, Criteria1:="Zone Noo"
      .AutoFilter Field:=6, Criteria1:="<>Zone ABC", Operator:=xlAnd, Criteria2:="<>Zone XYZ"
      If .Columns(1).SpecialCells(xlVisible).Count > 1 Then .Offset(1).EntireRow.Delete
    End With
    ws.AutoFilterMode = False
    With ws.Range("E5:G" & ws.Range("A" & Rows.Count).End(xlUp).Row)
      .Value = a
      On Error Resume Next
      Intersect(.Columns(0).SpecialCells(xlBlanks).EntireRow, .EntireColumn).ClearContents
      On Error GoTo 0
      .Columns(2).NumberFormat = "dd mm yy"
      .Columns(3).Font.Name = "Mistral"
      With .Offset(, -4).Resize(, 8)
        On Error Resume Next
        .SpecialCells(xlBlanks).Value = "text"
        On Error GoTo 0
        .EntireColumn.AutoFit
      End With
    End With
  Next ws
End Sub

 

[Blaster1]

Try this. Note that this structure will only work for two values that you want to keep in column F. If more are to be added then a significant change of approach would be needed.

BTW, how big (number of rows) is your actual data?

Sub FillValues_v4()
  Dim ws As Worksheet
  Dim a(1 To 3) As Variant

  a(1) = "John Smith":  a(2) = DateSerial(2021, 12, 9): a(3) = a(1)
  For Each ws In Worksheets
    With ws.Range("A4:F" & ws.Range("A" & Rows.Count).End(xlUp).Row)
      .AutoFilter Field:=2, Criteria1:=Array("ABC", "KLM", "XYZ", "ZYX"), Operator:=xlFilterValues
      If .Columns(1).SpecialCells(xlVisible).Count > 1 Then .Offset(1).EntireRow.Delete
      .AutoFilter Field:=2
      .AutoFilter Field:=1, Criteria1:="Zone Noo"
      .AutoFilter Field:=6, Criteria1:="<>Zone ABC", Operator:=xlAnd, Criteria2:="<>Zone XYZ"
      If .Columns(1).SpecialCells(xlVisible).Count > 1 Then .Offset(1).EntireRow.Delete
    End With
    ws.AutoFilterMode = False
    With ws.Range("E5:G" & ws.Range("A" & Rows.Count).End(xlUp).Row)
      .Value = a
      On Error Resume Next
      Intersect(.Columns(0).SpecialCells(xlBlanks).EntireRow, .EntireColumn).ClearContents
      On Error GoTo 0
      .Columns(2).NumberFormat = "dd mm yy"
      .Columns(3).Font.Name = "Mistral"
      With .Offset(, -4).Resize(, 8)
        On Error Resume Next
        .SpecialCells(xlBlanks).Value = "text"
        On Error GoTo 0
        .EntireColumn.AutoFit
      End With
    End With
  Next ws
End Sub

Thanks, it worked again appreciated.
I started new thread of my other question here:

Create Workbooks and Worksheets with specific formats

Hello All, Need your help with a VBA Code please. See below tables and requirement of code to do the following: 1) Check table1 and create 6 workbooks. a. Workbook 1 named AB-01 and has two worksheets (AB-01108 and AB-01115) b. Workbook 2 named AB-02 and has four worksheets (AB-02112...

www.mrexcel.com

 

[Peter_SSs]

Thanks, it worked again appreciated.

You're welcome. Thanks for the confirmation.