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
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
13,955
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
Not all functions or comparisons ignore whether a string is upper or lowercase.
But as you are using vbTextCompare the one that you are using does and so you can't get an "unexpected result", thus making the use of StrConv redundant.
 

Some videos you may like

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

eirikdaude

Board Regular
Joined
Nov 26, 2013
Messages
57
But as you are using vbTextCompare the one that you are using does and so you can't get an "unexpected result", thus making the use of StrConv redundant.
I never implied anything else. But since the overhead is miniscule my argument is that it does little harm to include it as a failsafe. If I for instance I'd forgotten to include the vbTextCompare argument to InStr, it would have made a difference whether the string was lowercase or not, as Option Compare defaults to binary.
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,086
Office Version
  1. 2013
Platform
  1. Windows
VBA Code:
Set r = ActiveSheet.Range("F1:F" & ActiveSheet.Range("F" & ActiveSheet.Rows.Count).End(xlUp).Row)
Should be like
VBA Code:
Set r = .Range("F1:F" & .Range("F" & ActiveSheet.Rows.Count).End(xlUp).Row)
And
VBA Code:
.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),"""")))"
.Range("C2:C" & Range("F" & Rows.Count).End(xlUp).Row).FillDown


.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),"""")))"
.Range("D2:D" & Range("F" & Rows.Count).End(xlUp).Row).FillDown
 

garypea123

Board Regular
Joined
Mar 16, 2020
Messages
80
Office Version
  1. 365
Platform
  1. Windows
This works a dream!!!! - Thank you ever so much for your help regarding this....
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,086
Office Version
  1. 2013
Platform
  1. Windows
You are welcome
And thank you for the feedback
Be happy
 

Watch MrExcel Video

Forum statistics

Threads
1,126,922
Messages
5,621,618
Members
415,847
Latest member
AlpinoHirsch

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