patternMinor
Spreadsheet Manipulations in Single Procedure
Viewed 0 times
spreadsheetsinglemanipulationsprocedure
Problem
I have written VBA code to copy and do some formatting and create sheets based on unique reference and insert some information. I want to optimize this code and make it short as much I can. The code is broken into parts to help make clearer what I am doing with it.
```
Sub Previous_comments_and_modifications()
Dim x As Long
Dim ws As Worksheet
Dim ds As Worksheet
Dim lastRow As Long
Dim updatesheet As String
Dim main_book As String
Dim user As String
Application.ScreenUpdating = False
user = Environ("username")
main_book = ActiveWorkbook.Name
'Inserting formulas on sheet SAP Data
lastRow = Workbooks(main_book).Worksheets("Sap Data").Range("B" & Rows.Count).End(xlUp).Row
With Workbooks(main_book).Worksheets("Sap Data")
.Range("B1").Value = "Assignment"
.Range("Q1").Value = "CC + GL"
.Range("Q2:Q" & lastRow).Formula = "=RC[-13]&""-""&RC[-11]"
.Range("R1").Value = "No. of Days"
.Range("S1").Value = "Ageing Group"
.Range("T1").Value = "Posting Done By"
With Sheets("Sap Data").Activate
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Columns(18).NumberFormat = "0"
Range("R2").Formula = "=EOMONTH(TODAY(),-1)-N2"
Range("R2").AutoFill Destination:=Range("R2:R" & lastRow)
End With
With Sheets("Sap Data").Activate
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("B2").Formula = "=Get_LongDescription(RC[1])"
Range("B2").AutoFill Destination:=Range("B2:B" & lastRow)
End With
With Sheets("Sap Data").Activate
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("S2").Formula = "=IF(RC[-1] a.Offset(-1).Value Then
With Workbooks(main_book)
.Sheets.Add After:=Sheets(Sheets.Count)
.Sheets(Sheets.Count).Name = a.Value
.Sheets(a.Value).Rows(1) = Sheets("Sap Data").Rows(1).Value
End With
End If
x = Workbooks(main_book).Worksheets(a.Value).Range("N" & Rows.Count).End(xlUp).Row + 1
Workbooks(main_book).Worksheets(a.Valu
```
Sub Previous_comments_and_modifications()
Dim x As Long
Dim ws As Worksheet
Dim ds As Worksheet
Dim lastRow As Long
Dim updatesheet As String
Dim main_book As String
Dim user As String
Application.ScreenUpdating = False
user = Environ("username")
main_book = ActiveWorkbook.Name
'Inserting formulas on sheet SAP Data
lastRow = Workbooks(main_book).Worksheets("Sap Data").Range("B" & Rows.Count).End(xlUp).Row
With Workbooks(main_book).Worksheets("Sap Data")
.Range("B1").Value = "Assignment"
.Range("Q1").Value = "CC + GL"
.Range("Q2:Q" & lastRow).Formula = "=RC[-13]&""-""&RC[-11]"
.Range("R1").Value = "No. of Days"
.Range("S1").Value = "Ageing Group"
.Range("T1").Value = "Posting Done By"
With Sheets("Sap Data").Activate
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Columns(18).NumberFormat = "0"
Range("R2").Formula = "=EOMONTH(TODAY(),-1)-N2"
Range("R2").AutoFill Destination:=Range("R2:R" & lastRow)
End With
With Sheets("Sap Data").Activate
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("B2").Formula = "=Get_LongDescription(RC[1])"
Range("B2").AutoFill Destination:=Range("B2:B" & lastRow)
End With
With Sheets("Sap Data").Activate
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("S2").Formula = "=IF(RC[-1] a.Offset(-1).Value Then
With Workbooks(main_book)
.Sheets.Add After:=Sheets(Sheets.Count)
.Sheets(Sheets.Count).Name = a.Value
.Sheets(a.Value).Rows(1) = Sheets("Sap Data").Rows(1).Value
End With
End If
x = Workbooks(main_book).Worksheets(a.Value).Range("N" & Rows.Count).End(xlUp).Row + 1
Workbooks(main_book).Worksheets(a.Valu
Solution
First, you should give your variables names that are descriptive -
Now you have a variable
You can also use MainWB for
After that, I'd use a couple different subs for each action you're taking. You don't (as far as I can tell) have any need for functions as nothing is being returned - but you could use a few sub-routines to break it apart.
Also, as I stated in the comments, try to avoid using
I assume you did a lot of this with the macro recorder - if so, great effort! But you can always optimize it.
You should also add some comments to describe not only what you're doing, but how it's doing it.
You have a lot of
Speaking of alignment, I don't know how your code is aligned in the VBE, but what you posted here had no indentation - that makes it terribly difficult to read. It also means you ended up with an extra
You also have this -
Is that a UDF?
Your
For me this -
is too much nesting. Looks to me like you just need to check for each WBMain sheet to match to
Do you need to insert all these formulas, every time? Shouldn't they just update as things change? If not, why use formulas when you could use val
Option Explicit
Sub Previous_comments_and_modifications()
Dim MainWB As Workbook
Set MainWB = ActiveWorkbook
Dim SapDataWS As Worksheet
Set SapDataWS = MainWB.Worksheets("SAP Data")
Dim user As String
user = Environ("username")
'What is x?
Dim x As Long
'What is ws and ds?
Dim MainWS As Worksheet
Dim UpdateWS As Worksheet
'This is looking for uniques, right?
Dim a As Range
'How can you tell which should be numbers or ranges?
Dim lastRow As Long
Dim startrow As Integer
Dim endrow As Range
Dim updatesheet As String
'Some of these weren't defined
'b is the result of a msgbox, why not call it "msgResult"
Dim b As Variant
Dim Filename As Boolean
'What is c?
Dim c As Range
Dim dtDate As DateNow you have a variable
SapDataWS that is the sheet constantly written out, so replace every Workbooks(main_book).Worksheets("Sap Data") with SapDataWS.You can also use MainWB for
Workbooks(main_book)After that, I'd use a couple different subs for each action you're taking. You don't (as far as I can tell) have any need for functions as nothing is being returned - but you could use a few sub-routines to break it apart.
Also, as I stated in the comments, try to avoid using
.Activate - it's not really needed. I assume you did a lot of this with the macro recorder - if so, great effort! But you can always optimize it.
You should also add some comments to describe not only what you're doing, but how it's doing it.
You have a lot of
With blocks. I'm not a huge fan myself, but if you keep everything aligned, I guess it could work.Speaking of alignment, I don't know how your code is aligned in the VBE, but what you posted here had no indentation - that makes it terribly difficult to read. It also means you ended up with an extra
end if and next ws that didn't have an if or for matched to them.You also have this -
Range("B2").Formula = "=Get_LongDescription(RC[1])"Is that a UDF?
Your
.Autofills look good to me. You may have unnecessary arguments in your .sorts.For me this -
'Its asking to copying comments from Previous Month File
Dim b As Variant
Dim Filename As Boolean
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
'Some formulas are insterted to reduce manual calculation
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
GoTo next_ws
End If
Next ds
next_ws:
End If
Next ws
Windows(updatesheet).Close
End Ifis too much nesting. Looks to me like you just need to check for each WBMain sheet to match to
Workbook(updatesheet) and then insert formulas. There has to be a better way to do this.Do you need to insert all these formulas, every time? Shouldn't they just update as things change? If not, why use formulas when you could use val
Code Snippets
Option Explicit
Sub Previous_comments_and_modifications()
Dim MainWB As Workbook
Set MainWB = ActiveWorkbook
Dim SapDataWS As Worksheet
Set SapDataWS = MainWB.Worksheets("SAP Data")
Dim user As String
user = Environ("username")
'What is x?
Dim x As Long
'What is ws and ds?
Dim MainWS As Worksheet
Dim UpdateWS As Worksheet
'This is looking for uniques, right?
Dim a As Range
'How can you tell which should be numbers or ranges?
Dim lastRow As Long
Dim startrow As Integer
Dim endrow As Range
Dim updatesheet As String
'Some of these weren't defined
'b is the result of a msgbox, why not call it "msgResult"
Dim b As Variant
Dim Filename As Boolean
'What is c?
Dim c As Range
Dim dtDate As DateRange("B2").Formula = "=Get_LongDescription(RC[1])"'Its asking to copying comments from Previous Month File
Dim b As Variant
Dim Filename As Boolean
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
'Some formulas are insterted to reduce manual calculation
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
GoTo next_ws
End If
Next ds
next_ws:
End If
Next ws
Windows(updatesheet).Close
End IfContext
StackExchange Code Review Q#110941, answer score: 6
Revisions (0)
No revisions yet.