HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Spreadsheet Manipulations in Single Procedure

Submitted by: @import:stackexchange-codereview··
0
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

Solution

First, you should give your variables names that are descriptive -

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 Date


Now 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 If


is 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 Date
Range("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 If

Context

StackExchange Code Review Q#110941, answer score: 6

Revisions (0)

No revisions yet.