LOOPING SAME VBA to different sheets

garypea123

Board Regular
Joined
Mar 16, 2020
Messages
80
Office Version
  1. 365
Platform
  1. Windows
Hi, I have the below macro written and I would like to to understand if I can can possibly apply this macro to run on

Monday Recieved
Tuesday Recieved
Wednesday Recieved
Thursday Recieved
Friday Recieved

I am sure that there is a neater way of doing this as opposed to writing the same script 5 times.


Sub Run

Sheets("Monday Recieved").Select - I assume that this will not be needed.

Columns("E:M").Select
Columns("E:M").EntireColumn.AutoFit
Range("E12").Select

Columns("J:J").SpecialCells(xlCellTypeBlanks).EntireRow.Delete



Range("B1").Select
ActiveCell.FormulaR1C1 = "Supplier"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Classification"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Band"

Dim c As Range, r As Range
Dim name As String
Const to_find As String = "ordered"

Set r = Sheet1.Range("F1:F" & Sheet1.Range("F" & Sheet1.Rows.Count).End(xlUp).Row)
Debug.Print r.Address

For Each c In r
If StrConv(c, vbLowerCase) = to_find Then
name = c.Offset(0, -1)
Else
c.Offset(0, -4) = name
End If
Next c


Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[4]="""","""",IF(RC[4]=""Received"","""",IF(AND(RC[4]>=0,RC[-1]<>""""),VLOOKUP(RC[-1],Vlookup!C[3]:C[4],2,0),"""")))"
Range("C2:C" & Range("F" & Rows.Count).End(xlUp).Row).FillDown


Range("D2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[3]="""","""",IF(RC[3]=""Received"","""",IF(AND(RC[3]>=0,RC[1]<>""""),VLOOKUP(RC[1],Vlookup!C[-2]:C[-1],2,0),"""")))"
Range("D2:D" & Range("F" & Rows.Count).End(xlUp).Row).FillDown

Sub End

Thanks,
Gary
 

Some videos you may like

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,088
Office Version
  1. 2013
Platform
  1. Windows
Hi
Try
VBA Code:
Sub tester()
    Dim arr As Variant
    Dim i As Long
    arr = Array("Monday Recieved", "Tuesday Recieved", "Wednesday Recieved", "Thursday Recieved", "Friday Recieved")
    For i = 0 To UBound(arr)
        With Sheets(arr(i))
            ' what ever you want to do'''''''''''''''
        End With
    Next
End Sub
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,088
Office Version
  1. 2013
Platform
  1. Windows
One more remark
avoid selecting
VBA Code:
Range("C2").FormulaR1C1 = _....


VBA Code:
Range("D2").Select
ActiveCell.FormulaR1C1 = _
 

garypea123

Board Regular
Joined
Mar 16, 2020
Messages
80
Office Version
  1. 365
Platform
  1. Windows
Thanks, I am not getting an error message come up when I run (which is a good start)

However, it is only applying the script on the active sheet I am on. (This is likely due to:)

Set r = ActiveSheet.Range("F1:F" & ActiveSheet.Range("F" & ActiveSheet.Rows.Count).End(xlUp).Row)
Debug.Print r.Address

So it seems like I may need to change this some how to know to apply it to all the sheets in the array. I did try to change ActiveSheet to Arr or Array. But this did not work :(



Sub tester()
Dim arr As Variant
Dim i As Long
arr = Array("Monday Recieved", "Tuesday Recieved", "Wednesday Recieved", "Thursday Recieved", "Friday Recieved")
For i = 0 To UBound(arr)
With Sheets(arr(i))

Dim c As Range, r As Range
Dim name As String
Const to_find As String = "ordered"

Set r = ActiveSheet.Range("F1:F" & ActiveSheet.Range("F" & ActiveSheet.Rows.Count).End(xlUp).Row)
Debug.Print r.Address

For Each c In r
If StrConv(c, vbLowerCase) = to_find Then
name = c.Offset(0, -1)
Else
c.Offset(0, -4) = name
End If
Next c


Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[4]="""","""",IF(RC[4]=""Received"","""",IF(AND(RC[4]>=0,RC[-1]<>""""),VLOOKUP(RC[-1],Vlookup!C[3]:C[4],2,0),"""")))"
Range("C2:C" & Range("F" & Rows.Count).End(xlUp).Row).FillDown


Range("D2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[3]="""","""",IF(RC[3]=""Received"","""",IF(AND(RC[3]>=0,RC[1]<>""""),VLOOKUP(RC[1],Vlookup!C[-2]:C[-1],2,0),"""")))"
Range("D2:D" & Range("F" & Rows.Count).End(xlUp).Row).FillDown


End With
Next
End Sub
 

eirikdaude

Board Regular
Joined
Nov 26, 2013
Messages
57

ADVERTISEMENT

You could try something like

1. Change the codename of each sheet for a workday to something like "Monday", "Tuesday", etc.

2. Then run something like this to loop over all the sheets in your workbook, and only do something to the ones which has e.g. "day" in their codename.

VBA Code:
Option Explicit

Sub tet()
    Dim ws As Worksheet
   
    For Each ws In ThisWorkbook.Worksheets
        If InStr(1, StrConv(ws.CodeName, LCase), "day", vbTextCompare) > 0 Then
            ' whatever you want to do with the sheets whose codename contains "day", e.g.
            Call what_i_want_to_do(ws)
        End If
    Next ws
End Sub

Private Sub what_i_want_to_do(ws As Worksheet)
    Dim c As Range, r As Range
    Dim name As String
    Const to_find As String = "ordered"
   
    Set r = ws.Range("F1:F" & ws.Range("F" & ws.Rows.Count).End(xlUp).Row)
   
    For Each c In r
        If StrConv(c, vbLowerCase) = to_find Then
            name = c.Offset(0, -1)
        Else
            c.Offset(0, -4) = name
        End If
    Next c


    ws.Range("C2").FormulaR1C1 = "=IF(RC[4]="""","""",IF(RC[4]=""Received"","""",IF(AND(RC[4]>=0,RC[-1]<>""""),VLOOKUP(RC[-1],Vlookup!C[3]:C[4],2,0),"""")))"
    ws.Range("C2:C" & ws.Range("F" & ws.Rows.Count).End(xlUp).Row).FillDown

    ws.Range("D2").FormulaR1C1 = "=IF(RC[3]="""","""",IF(RC[3]=""Received"","""",IF(AND(RC[3]>=0,RC[1]<>""""),VLOOKUP(RC[1],Vlookup!C[-2]:C[-1],2,0),"""")))"
    ws.Range("D2:D" & ws.Range("F" & ws.Rows.Count).End(xlUp).Row).FillDown
End Sub
 

garypea123

Board Regular
Joined
Mar 16, 2020
Messages
80
Office Version
  1. 365
Platform
  1. Windows
Thank you,

It makes sense in terms of the logic used, and I have created the code names.

However, I do get an error message (as attached)
Capture.PNG
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,250
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

That should be vbLowerCase
Although it's pretty redundant, you can just use
VBA Code:
If InStr(1, ws.CodeName, "day", vbTextCompare) > 0 Then
 

eirikdaude

Board Regular
Joined
Nov 26, 2013
Messages
57
What @Fluff said. I typed it out because it is good to get into good habits, and it makes the code more readable. The reason it's redundant is that when you use vbTextCompare as the fourth argument of InStr, the comparison won't care about case.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,250
Office Version
  1. 365
Platform
  1. Windows
it makes the code more readable.
I would have to disagree on this, I feel it makes the code harder to read & figure out. Especially for a newcomer.
I also don't see how using a totally redundant function is a "good habit"
 

eirikdaude

Board Regular
Joined
Nov 26, 2013
Messages
57
I would have to disagree on this, I feel it makes the code harder to read & figure out. Especially for a newcomer.
I also don't see how using a totally redundant function is a "good habit"

Not all functions or comparisons ignore whether a string is upper or lowercase. Ensuring as many failsafes as possible will make those occassions when it does not won't lead to unexpected results
 

Watch MrExcel Video

Forum statistics

Threads
1,126,981
Messages
5,621,958
Members
415,869
Latest member
LWSkinner

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
Top