This workbook is used to track projects and I have this VBA code linked to a Form Control button, when I press the button it will run through and get information from all the project sheets and feed it to appropriate areas. I want to figure out how I can combine some of these loops where it reads through my entire work book. Here is my code :
Sub Run_ALL_InfoMacros()
'Module 5 = WIG Sheet1, for all information to be on one sheet
With Worksheets("Sheet1")
' Clear previous data on the All projects page
.Rows("2:" & Rows.Count).ClearContents
For Each ws In ThisWorkbook.Worksheets
If ws.Range("A5") = "Project # :" Then
x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row
.Cells(x, "A").Value = ws.Name 'classifying number
.Cells(x, "B").Formula = "='" & ws.Name & "'!$B$5" 'Project #
.Cells(x, "C").Formula = "='" & ws.Name & "'!$A$1" 'Project Name
.Cells(x, "D").Formula = "='" & ws.Name & "'!$B$8" 'Project Engineer
.Cells(x, "E").Formula = "='" & ws.Name & "'!$B$6" 'Maximo Time Charge
.Cells(x, "F").Formula = "='" & ws.Name & "'!$E$5" 'Material Forecast due date
.Cells(x, "G").Formula = "=IF('" & ws.Name & "'!$E$11>0,'" & ws.Name & "'!$E$11,TEXT(,))"
'.Cells(x, "G").Formula = "='" & ws.Name & "'!$E$11" 'Materials Forecast Actual
.Cells(x, "H").Formula = "='" & ws.Name & "'!$F$11" 'Forecast success
.Cells(x, "I").Formula = "='" & ws.Name & "'!$F$12" 'IFC Success
.Cells(x, "J").Formula = "='" & ws.Name & "'!$E$6" '30% Due
'.Cells(x, "K").Formula = "='" & ws.Name & "'!$E$13" '30% actual
.Cells(x, "K").Formula = "=IF('" & ws.Name & "'!$E$13>0,'" & ws.Name & "'!$E$13,TEXT(,))"
.Cells(x, "L").Formula = "='" & ws.Name & "'!$F$13" '30% success
.Cells(x, "M").Formula = "='" & ws.Name & "'!$E$7" '60% due
'.Cells(x, "N").Formula = "='" & ws.Name & "'!$E$14" '60% actual
.Cells(x, "N").Formula = "=IF('" & ws.Name & "'!$E$14>0,'" & ws.Name & "'!$E$14,TEXT(,))"
.Cells(x, "O").Formula = "='" & ws.Name & "'!$F$14" '60% Success
.Cells(x, "P").Formula = "='" & ws.Name & "'!$E$8" '90% due
'.Cells(x, "Q").Formula = "='" & ws.Name & "'!$E$15" '90% actual
.Cells(x, "Q").Formula = "=IF('" & ws.Name & "'!$E$15>0,'" & ws.Name & "'!$E$15,TEXT(,))"
.Cells(x, "R").Formula = "='" & ws.Name & "'!$F$15" '90% success
.Cells(x, "S").Formula = "='" & ws.Name & "'!$B$11" 'In-service Due
'.Cells(x, "T").Formula = "='" & ws.Name & "'!$E$16" 'In-service actual
.Cells(x, "T").Formula = "=IF('" & ws.Name & "'!$E$16>0,'" & ws.Name & "'!$E$16,TEXT(,))"
.Cells(x, "U").Formula = "='" & ws.Name & "'!$F$16" 'In-service Success
.Cells(x, "V").Formula = "='" & ws.Name & "'!$E$4" 'IFC Scheduled
'.Cells(x, "W").Formula = "='" & ws.Name & "'!$E$12" 'IFC Actual
.Cells(x, "W").Formula = "=IF('" & ws.Name & "'!$E$12>0,'" & ws.Name & "'!$E$12,TEXT(,))"
.Cells(x, "X").Formula = "='" & ws.Name & "'!$B$15" 'Non Stores Items
.Cells(x, "Y").Formula = "='" & ws.Name & "'!$B$16" 'Non Stores Items Ordered on time
.Cells(x, "Z").Formula = "='" & ws.Name & "'!$A$17" 'Non Stores Items Success
.Cells(x, "AA").Formula = "='" & ws.Name & "'!$B$17" 'Non Stores Items Percentage
End If
Next
End With
'Module 7 = WIG current & upcoming Projects, for all projects with NO Actual In-service Date Inputted
With Worksheets("Current & Upcoming Projects")
' Clear previous data on the All projects page
.Rows("3:" & Rows.Count).ClearContents
For Each ws In ThisWorkbook.Worksheets
If ws.Range("A5") = "Project # :" And ws.Range("E16") = "" Then
x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row
.Cells(x, "A").Value = ws.Name 'classifying number
.Cells(x, "B").Formula = "='" & ws.Name & "'!$B$5" 'Project #
.Cells(x, "C").Formula = "='" & ws.Name & "'!$A$1" 'Project Name
.Cells(x, "D").Formula = "='" & ws.Name & "'!$B$8" 'Project Engineer
.Cells(x, "E").Formula = "='" & ws.Name & "'!$B$11" 'In-service Due
.Cells(x, "F").Formula = "='" & ws.Name & "'!$E$6" '30% Due
.Cells(x, "G").Formula = "='" & ws.Name & "'!$F$13" '30% Success
.Cells(x, "H").Formula = "='" & ws.Name & "'!$E$7" '60% due
.Cells(x, "I").Formula = "='" & ws.Name & "'!$F$14" '60% Success
.Cells(x, "J").Formula = "='" & ws.Name & "'!$E$8" '90% due
.Cells(x, "K").Formula = "='" & ws.Name & "'!$F$15" '90% Success
.Cells(x, "L").Formula = "='" & ws.Name & "'!$E$5" 'Material Forecast due date
.Cells(x, "M").Formula = "='" & ws.Name & "'!$F$11" 'Materials Forecast Success
.Cells(x, "N").Formula = "='" & ws.Name & "'!$B$15" 'Non Stores Items
.Cells(x, "O").Formula = "='" & ws.Name & "'!$B$16" 'Non Stores Items Ordered on time
.Cells(x, "P").Formula = "='" & ws.Name & "'!$A$17" 'Non Stores Items Success
End If
Next
End With
'Module 2 = WIG Completed Project Info , For all the projects that are already in-service.
With Worksheets("Completed Project Info")
' Clear previous data on the All projects page
.Rows("3:" & Rows.Count).ClearContents
For Each ws In ThisWorkbook.Worksheets
If ws.Range("A5") = "Project # :" And ws.Range("E16") >= Sheet6.Range("F1") Then
x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row
.Cells(x, "A").Value = ws.Name 'classifying number
.Cells(x, "B").Formula = "='" & ws.Name & "'!$B$5" 'Project #
.Cells(x, "C").Formula = "='" & ws.Name & "'!$A$1" 'Project Name
.Cells(x, "D").Formula = "='" & ws.Name & "'!$B$8" 'Project Engineer
.Cells(x, "E").Formula = "='" & ws.Name & "'!$B$11" 'In-service Due
.Cells(x, "F").Formula = "='" & ws.Name & "'!$E$16" 'In-service Actual
.Cells(x, "G").Formula = "='" & ws.Name & "'!$E$6" '30% Due
'.Cells(x, "H").Formula = "='" & ws.Name & "'!$E$13" '30% actual
.Cells(x, "H").Formula = "='" & ws.Name & "'!$F$13" '30% Success
.Cells(x, "I").Formula = "='" & ws.Name & "'!$E$7" '60% due
'.Cells(x, "J").Formula = "='" & ws.Name & "'!$E$14" '60% actual
.Cells(x, "J").Formula = "='" & ws.Name & "'!$F$14" '60% Success
.Cells(x, "K").Formula = "='" & ws.Name & "'!$E$8" '90% due
'.Cells(x, "L").Formula = "='" & ws.Name & "'!$E$15" '90% actual
.Cells(x, "L").Formula = "='" & ws.Name & "'!$F$15" '90% Success
.Cells(x, "M").Formula = "='" & ws.Name & "'!$E$5" 'Material Forecast due date
'.Cells(x, "N").Formula = "='" & ws.Name & "'!$E$11" 'Materials Forecast Actual
.Cells(x, "N").Formula = "='" & ws.Name & "'!$F$11" 'Materials Forecast Success
.Cells(x, "O").Formula = "='" & ws.Name & "'!$B$15" 'Non Stores Items
.Cells(x, "P").Formula = "='" & ws.Name & "'!$B$16" 'Non Stores Items Ordered on time
End If
Next
End With
'For Non-Stores Material
With Worksheets("Data Sheet")
' Clear previous data on the All projects page
.Rows("141:" & Rows.Count).ClearContents
For Each ws In ThisWorkbook.Worksheets
If ws.Range("A5") = "Project # :" Then
Dim Z As Integer
Z = 19
Do While Not ws.Range("A" & Z) = "" And Not IsNull(ws.Range("A" & Z))
x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row
.Cells(x, "A").Value = ws.Name 'classifying number
.Cells(x, "B").Formula = "='" & ws.Name & "'!$A$" & Z 'Non-stores material
.Cells(x, "D").Formula = "='" & ws.Name & "'!$C$" & Z 'Lead Time
.Cells(x, "F").Formula = "='" & ws.Name & "'!$E$" & Z 'Order By Date
.Cells(x, "G").Formula = "='" & ws.Name & "'!$F$" & Z 'Date Ordered
.Cells(x, "H").Formula = "='" & ws.Name & "'!$G$" & Z 'Goals Met
Z = Z + 1
Loop
End If
Next
End With
End Sub
If that is your whole code I'd suggest inserting this right after initializing your sub:
screenUpdateState = Application.ScreenUpdating
statusBarState = Application.DisplayStatusBar
calcState = Application.Calculation
eventsState = Application.EnableEvents
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
At the very end of your code (above End Sub) reverse it:
Application.ScreenUpdating = screenUpdateState
Application.DisplayStatusBar = statusBarState
Application.Calculation = calcState
Application.EnableEvents = eventsState
These settings should give you a nice boost in performance.
This is what I do - at the beginning of your code write
Call OnStart
At the end Write
Call OnEnd
Somewhere write the following:
Public Sub OnEnd()
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
Application.StatusBar = False
End Sub
Public Sub OnStart()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.Calculation = xlAutomatic
ActiveWindow.View = xlNormalView
End Sub
Related
The workbook I am working on is used for project tracking. On the opening page it is the current&upcoming projects page. When you press a Form Control Button it executes the code below. What the code below does is reads through each sheet in the workbook(has 30 sheets), and then all the sheets that have value "Project # :" in A5. When it has that value it will put specified values into the specified row and column. The line with "**" at the beginning is the one that doesn't work. The line below it with "*" next to it is what I temporarily use, but that has no hyperlink, just the sheets name.
What I want to happen in the code below is make Row "A" contain the sheets names as text and hyperlink to that sheet
For Each ws In ThisWorkbook.Worksheets
If ws.Range("A5") = "Project # :" And ws.Range("E16") = "" Then
x = .Range("B" & Rows.Count).End(xlUp).Offset(1).row
**.Cells(x, "A").Formula = "=ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _'" & ws.Name & "'"
*.Cells(x, "A").Value = ws.Name 'classifying number
.Cells(x, "B").Formula = "='" & ws.Name & "'!$B$5" 'Project #
.Cells(x, "C").Formula = "='" & ws.Name & "'!$A$1" 'Project Name
.Cells(x, "D").Formula = "='" & ws.Name & "'!$B$8" 'Project Engineer
.Cells(x, "E").Formula = "='" & ws.Name & "'!$B$11" 'In-service Due
.Cells(x, "F").Formula = "='" & ws.Name & "'!$E$6" '30% Due
.Cells(x, "G").Formula = "='" & ws.Name & "'!$F$13" '30% Success
.Cells(x, "H").Formula = "='" & ws.Name & "'!$E$7" '60% due
.Cells(x, "I").Formula = "='" & ws.Name & "'!$F$14" '60% Success
.Cells(x, "J").Formula = "='" & ws.Name & "'!$E$8" '90% due
.Cells(x, "K").Formula = "='" & ws.Name & "'!$F$15" '90% Success
.Cells(x, "L").Formula = "='" & ws.Name & "'!$E$5" 'Material Forecast due date
.Cells(x, "M").Formula = "='" & ws.Name & "'!$F$11" 'Materials Forecast Success
.Cells(x, "N").Formula = "='" & ws.Name & "'!$B$15" 'Non Stores Items
.Cells(x, "O").Formula = "='" & ws.Name & "'!$B$16" 'Non Stores Items Ordered on time
.Cells(x, "P").Formula = "='" & ws.Name & "'!$A$17" 'Non Stores Items Success
End If
Next
End With
Instead of
.Cells(x, "A").Formula = "=ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _'" & ws.Name & "'"
use
.Hyperlinks.Add Anchor:=.Cells(x, "A"), _
Address:="", _
SubAddress:= "'" & ws.Name & "'!A1", _
TextToDisplay:= ws.Name
I have assumed that your code is being executed within a With ActiveSheet (or equivalent) block.
I have code so far which I have posted below, but as you can see it's very insufficient way to do it and isn't running a loop and wont help me if I end having more than items that are below A22. What the code here is doing is when I press a button it will read through each sheet on the workbook and if cell A5 has "Project # :" then it will see if cell A19 has anything if it does it will take whats in cell A19,C19,E19,F19 and G19 and put it on my worksheet named "Data Sheet". The current code has it so it does that process through A22 but I want it to be automated with a loop so that it checks the cell A5 for "Project # :" and if it finds that then it checks if A19 is blank, if it is end the loop. If it has any sort of text then I want it to take the values from Column A,C,E,F and G and putting it onto the "Data Sheet" . Then it will loop to the next now (row 20) and repeat the process it did for the previous one.
Currently my code is correctly working to get the data to the right spot but my IF-ELSE for rows 19-22 is just inefficient and not sure how to code the loop.
Sub NonStoresItems()
With Worksheets("Data Sheet")
' Clear previous data on the All projects page
.Rows("141:" & Rows.Count).ClearContents
For Each ws In ThisWorkbook.Worksheets
If ws.Range("A5") = "Project # :" Then
If Range("A19") = "" Then
Else:
x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row
.Cells(x, "A").Value = ws.Name 'classifying number
.Cells(x, "B").Formula = "='" & ws.Name & "'!$A$19" 'Non-stores material
.Cells(x, "D").Formula = "='" & ws.Name & "'!$C$19" 'Lead Time
.Cells(x, "F").Formula = "='" & ws.Name & "'!$E$19" 'Order By Date
.Cells(x, "G").Formula = "='" & ws.Name & "'!$F$19" 'Date Ordered
.Cells(x, "H").Formula = "='" & ws.Name & "'!$G$19" 'Goals Met
End If
If Range("A20") = "" Then
Else:
x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row
.Cells(x, "A").Value = ws.Name 'classifying number
.Cells(x, "B").Formula = "='" & ws.Name & "'!$A$20" 'Non-stores material
.Cells(x, "D").Formula = "='" & ws.Name & "'!$C$20" 'Lead Time
.Cells(x, "F").Formula = "='" & ws.Name & "'!$E$20" 'Order By Date
.Cells(x, "G").Formula = "='" & ws.Name & "'!$F$20" 'Date Ordered
.Cells(x, "H").Formula = "='" & ws.Name & "'!$G$20" 'Goals Met
End If
If Range("A21") = "" Then
Else:
x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row
.Cells(x, "A").Value = ws.Name 'classifying number
.Cells(x, "B").Formula = "='" & ws.Name & "'!$A$21" 'Non-stores material
.Cells(x, "D").Formula = "='" & ws.Name & "'!$C$21" 'Lead Time
.Cells(x, "F").Formula = "='" & ws.Name & "'!$E$21" 'Order By Date
.Cells(x, "G").Formula = "='" & ws.Name & "'!$F$21" 'Date Ordered
.Cells(x, "H").Formula = "='" & ws.Name & "'!$G$21" 'Goals Met
End If
If Range("A22") = "" Then
Else:
x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row
.Cells(x, "A").Value = ws.Name 'classifying number
.Cells(x, "B").Formula = "='" & ws.Name & "'!$A$22" 'Non-stores material
.Cells(x, "D").Formula = "='" & ws.Name & "'!$C$22" 'Lead Time
.Cells(x, "F").Formula = "='" & ws.Name & "'!$E$22" 'Order By Date
.Cells(x, "G").Formula = "='" & ws.Name & "'!$F$22" 'Date Ordered
.Cells(x, "H").Formula = "='" & ws.Name & "'!$G$22" 'Goals Met
End If
End If
Next
End With
End Sub
Data Sheet Output
Input
You can use this in place of your If...Else statements
z = 19
Do While Not Range("A" & z) = ""
x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row
.Cells(x, "A").Value = ws.Name 'classifying number
.Cells(x, "B").Formula = "='" & ws.Name & "'!$A$" & z 'Non-stores material
.Cells(x, "D").Formula = "='" & ws.Name & "'!$C$" & z 'Lead Time
.Cells(x, "F").Formula = "='" & ws.Name & "'!$E$" & z 'Order By Date
.Cells(x, "G").Formula = "='" & ws.Name & "'!$F$" & z 'Date Ordered
.Cells(x, "H").Formula = "='" & ws.Name & "'!$G$" & z 'Goals Met
z = z + 1
Loop
This will loop until it finds and empty value in column A, if you want to stop at 22 every time just add AND z < 23 to the Do While condition.
I am currently working on parsing data from multiple worksheets within multiple workbooks into a summary worksheet. I have been able to select certain cells from all sheets and workbooks but would like to extract a range of columns if possible. How can I add this option to my loop condition?
for example If I have a worksheet called "Monday" and I would like to extract the cell range A2 through C57 and add it to my newly created worksheet.
Option Explicit
Sub GetMyData()
Dim myDir As String, fn As String, SheetName As String, SheetName2 As String, SheetName3 As String, n As Long, NR As Long
'***** Change Folder Path *****
myDir = "C:\attach"
'***** Change Sheetname(s) *****
SheetName = "Title"
SheetName2 = "Total"
SheetName3 = "Monday"
'***Loops through specified directory and parces data from each worksheet within each workbook by selecting specified .
fn = Dir(myDir & "\*.xlsx")
Do While fn <> ""
If fn <> ThisWorkbook.Name Then
With ThisWorkbook.Sheets("ImportTable")
NR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
'Pick cells from worksheet "Title"
With .Range("A" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!A1"
.Value = .Value
End With
With .Range("B" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!A2"
.Value = .Value
End With
With .Range("C" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!B4"
.Value = .Value
End With
With .Range("D" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!B5"
.Value = .Value
End With
With .Range("E" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!B6"
.Value = .Value
End With
With .Range("F" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & SheetName & "'!B7"
.Value = .Value
End With
With .Range("G" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & SheetName2 & "'!B26"
.Value = .Value
End With
With .Range("H" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & SheetName2 & "'!A1"
.Value = .Value
End With
End With
End If
fn = Dir
Loop
ThisWorkbook.Sheets("ImportTable").Columns.AutoFit
End Sub
If you move your link creation to a separate sub your code will be more concise, and you can have the sub automatically adjust the type of formula (regular for single cells, or array formula for blocks of cells)
Sub tester()
Dim rng As Range
Set rng = ActiveSheet.Range("A2")
LinkToFile "C:\_Stuff\test", "temp report.xlsx", "Sheet1", "A1:D20", rng
Set rng = ActiveSheet.Range("F2")
LinkToFile "C:\_Stuff\test", "temp report.xlsx", "Sheet1", "A1", rng
End Sub
Sub LinkToFile(fPath As String, fName As String, shtName As String, _
addr As String, rngInsert As Range)
Dim rngTmp As Range, f As String
If Right(fPath, 1) <> "\" Then fPath = fPath & "\" 'win only!
f = "='" & fPath & "[" & fName & "]" & shtName & "'!" & addr
'linking to a range, or a single cell ?
If InStr(addr, ":") > 0 Then
Set rngTmp = rngInsert.Parent.Range(addr) 'to get num rows/cols
rngInsert.Resize(rngTmp.Rows.Count, rngTmp.Columns.Count).FormulaArray = f
Else
rngInsert.Formula = f
End If
End Sub
I am trying to parse data from multiple workbooks with multiple worksheets into a single summary worksheet or workbook. So far I have been able to collect data from the specified cells, however I would like to include a range of cells for example ("A2:B20"). How can I specify this in looping process?
Option Explicit
Sub GetMyData()
Dim myDir As String, fn As String, sn As String, sn2 As String, n As Long, NR As Long
'***** Change Folder Path *****
myDir = "C:\attach"
'***** Change Sheetname(s) *****
sn = "Title"
sn2 = "Monday"
fn = Dir(myDir & "\*.xlsx")
Do While fn <> ""
If fn <> ThisWorkbook.Name Then
With ThisWorkbook.Sheets("Sheet10")
NR = .Cells(Rows.count, 1).End(xlUp).Row + 1
'Pick cells from worksheet "Title"
With .Range("A" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!B4"
.Value = .Value
End With
With .Range("B" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!B5"
.Value = .Value
End With
With .Range("C" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!B6"
.Value = .Value
End With
With .Range("D" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!B7"
.Value = .Value
End With
With .Range("E" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!A1"
.Value = .Value
End With
With .Range("F" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!A2"
.Value = .Value
End With
'pick cells from worksheet "Monday"
With .Range("G" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn2 & Range("A1:C57")
End With
End With
End If
fn = Dir
Loop
ThisWorkbook.Sheets("Sheet10").Columns.AutoFit
End Sub
You can do Either
Col_1 = "A"
Col_2 = "B"
i = 2
j = 20
Range(Col_1 & i,Col_2 & j)
or
Col_1 = "A"
i = 2
j = 20
Range(Col_1 & i).Resize(j-i+1,2)
Hope this helps
There are a couple of ways to do this, supposing you want a continuous range:
Pass that exact string to the Range function. e.g. Range("A3:C10")
Pass the "first" cell as the first argument and the "last cell" as the second argument. e.g. Range("A3", "C10")
I was working with optimisation of code and after review from man people asked me to use Option Explicit and define Variables for everything and shorten the code. Which i did to maximum possible But the below code copies data from another excel by asking path and copy some specific data in column V and W. Also there is formula which compare data and find exact rows and which need to be copy.
Now please help how should i optimise this code and give variables to it.
Or please provide code in which we can compare 2 excel for example: A2:E is same then it should copy H2:I
For Each ws In MainWB.Worksheets
If ws.Name <> "Sap Data" And ws.Name <> "Automated BL Import" Then
With MainWB.Worksheets(ws.Name)
.Range("V1").Value = "When it will be Cleared or Action Taken/Required"
.Range("W1").Value = "Backup Link"
LastRow = MainWB.Worksheets(ws.Name).Range("B" & Rows.Count).End(xlUp).Row
.Range("Q1:Q" & LastRow).Delete
End With
End If
Next ws
b = MsgBox("Do you want to update comments for current postings from previous month?" & vbCrLf & vbCrLf & "Note:- If are runing this macro for the 1st time plese choose option 'No'", _
vbYesNo + vbQuestion, "Question")
If b = vbYes Then
Filename = Application.GetOpenFilename(, , "Please select previous month BL comment file to update comments.", , False)
If Filename <> "False" Then
Workbooks.Open Filename, Format:=2
End If
updatesheet = ActiveWorkbook.Name
For Each ws In MainWB.Sheets
If ws.Name <> "Sap Data" And ws.Name <> "Automated BL Import" Then
For Each ds In Workbooks(updatesheet).Sheets
If ds.Name = ws.Name Then
LastRow = MainWB.Worksheets(ws.Name).Range("B" & Rows.Count).End(xlUp).Row
With MainWB.Worksheets(ws.Name)
.Range("T2:T" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-1],'[" & updatesheet & "]" & ws.Name & "'!R2C[-1]:R1048576C,2,0) = 0,"""",VLOOKUP(RC[-1],'[" & updatesheet & "]" & ws.Name & "'!R2C[-1]:R1048576C,2,0)),"""")"
.Range("U2:U" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-2],'[" & updatesheet & "]" & ws.Name & "'!R2C[-2]:R1048576C,3,0) = 0,"""",VLOOKUP(RC[-2],'[" & updatesheet & "]" & ws.Name & "'!R2C[-2]:R1048576C,3,0)),"""")"
.Range("V2:V" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-3],'[" & updatesheet & "]" & ws.Name & "'!R2C[-3]:R1048576C,4,0) = 0,"""",VLOOKUP(RC[-3],'[" & updatesheet & "]" & ws.Name & "'!R2C[-3]:R1048576C,4,0)),"""")"
.Range("W2:W" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-4],'[" & updatesheet & "]" & ws.Name & "'!R2C[-4]:R1048576C,5,0) = 0,"""",VLOOKUP(RC[-4],'[" & updatesheet & "]" & ws.Name & "'!R2C[-4]:R1048576C,5,0)),"""")"
.Range("X2:X" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-5],'[" & updatesheet & "]" & ws.Name & "'!R2C[-5]:R1048576C,6,0) = 0,"""",VLOOKUP(RC[-5],'[" & updatesheet & "]" & ws.Name & "'!R2C[-5]:R1048576C,6,0)),"""")"
.Range("T2:X" & LastRow).Value = MainWB.Worksheets(ws.Name).Range("T2:X" & LastRow).Value
End With
Your bottom part is a mess, you are missing some end ifs, You are missing the dims for the variables
The first part of the code is below.
You need to explain what you are trying to do with the second part of the code.
Sub Button1_Click()
Dim wb As Workbook, ws As Worksheet
Dim bk As Workbook, sh As Worksheet
Set wb = Workbooks("ThisOne.xlsm")
For Each ws In wb.Sheets
If ws.Name <> "Sap Data" And ws.Name <> "Automated BL Import" Then
With ws
.Range("V1").Value = "When it will be Cleared or Action Taken/Required"
.Range("W1").Value = "Backup Link"
LastRow = ws.Range("B" & Rows.Count).End(xlUp).Row
.Range("Q1:Q" & LastRow).Delete'?
End With
End If
Next ws
b = MsgBox("Do you want to update comments for current postings from previous month?" & vbCrLf & vbCrLf & "Note:- If are runing this macro for the 1st time plese choose option 'No'", _
vbYesNo + vbQuestion, "Question")
If b = vbYes Then
Filename = Application.GetOpenFilename(, , "Please select previous month BL comment file to update comments.", , False)
If Filename <> "False" Then
Workbooks.Open Filename, Format:=2
End If
Else: Exit Sub
End If
Set bk = ActiveWorkbook
' updatesheet = ActiveWorkbook.Name'what is this for?
For Each sh In bk.Sheets
' If sh.Name <> "Sap Data" And ws.Name <> "Automated BL Import" Then
' For Each ds In Workbooks(updatesheet).Sheets
' If ds.Name = ws.Name Then
' LastRow = MainWB.Worksheets(ws.Name).Range("B" & Rows.Count).End(xlUp).Row
' With MainWB.Worksheets(ws.Name)
' .Range("T2:T" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-1],'[" & updatesheet & "]" & ws.Name & "'!R2C[-1]:R1048576C,2,0) = 0,"""",VLOOKUP(RC[-1],'[" & updatesheet & "]" & ws.Name & "'!R2C[-1]:R1048576C,2,0)),"""")"
' .Range("U2:U" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-2],'[" & updatesheet & "]" & ws.Name & "'!R2C[-2]:R1048576C,3,0) = 0,"""",VLOOKUP(RC[-2],'[" & updatesheet & "]" & ws.Name & "'!R2C[-2]:R1048576C,3,0)),"""")"
' .Range("V2:V" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-3],'[" & updatesheet & "]" & ws.Name & "'!R2C[-3]:R1048576C,4,0) = 0,"""",VLOOKUP(RC[-3],'[" & updatesheet & "]" & ws.Name & "'!R2C[-3]:R1048576C,4,0)),"""")"
' .Range("W2:W" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-4],'[" & updatesheet & "]" & ws.Name & "'!R2C[-4]:R1048576C,5,0) = 0,"""",VLOOKUP(RC[-4],'[" & updatesheet & "]" & ws.Name & "'!R2C[-4]:R1048576C,5,0)),"""")"
' .Range("X2:X" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-5],'[" & updatesheet & "]" & ws.Name & "'!R2C[-5]:R1048576C,6,0) = 0,"""",VLOOKUP(RC[-5],'[" & updatesheet & "]" & ws.Name & "'!R2C[-5]:R1048576C,6,0)),"""")"
' .Range("T2:X" & LastRow).Value = MainWB.Worksheets(ws.Name).Range("T2:X" & LastRow).Value
' End With
' End If
' Next ds
' End If
Next sh
End Sub