PDA

View Full Version : VBA - help optimise/clean up the code



Ports
12-24-2018, 08:37 AM
Hi,

I'm new to VBA but not new to programming. Because I have some experience with other languages I can see that my code is far from good. There's a lot of duplication. I put it together by copy/pasting from online sources and/or googling some specific commands.

Would someone be able to help make it more concise or optimised:


Sub ValidateReturn()
DeleteFirstSheet
CreateSheet
CopyAims
FillBlanks
SplitLearnerDetails
End Sub

Sub SplitLearnerDetails()
Dim tw As Worksheet: Set tw = ThisWorkbook.Sheets("FundingReturn") 'target worksheet
tw.Activate
Range("A1").EntireColumn.Insert Shift:=xlToRight
Range("A1").EntireColumn.Insert Shift:=xlToRight
Range("A1").EntireColumn.Insert Shift:=xlToRight
Dim substrings() As String
Dim i As Long
lRow = Cells(Rows.Count, 4).End(xlUp).Row
For i = 1 To lRow
substrings = Split(Cells(i, 4), " - ")
Cells(i, 1).Value = substrings(0) & "-" & Cells(i, 5)
Cells(i, 2).Value = substrings(0)
Cells(i, 3).Value = substrings(1)
Next i
End Sub

Sub FillBlanks()
Dim lRow As Long
Dim tw As Worksheet: Set tw = ThisWorkbook.Sheets("FundingReturn") 'target worksheet
tw.Activate
'Find the last non-blank cell in column A(1)
'I think this needs to be changed to 1 below as we re not inserting it yet
lRow = Cells(Rows.Count, 2).End(xlUp).Row
'Iterate over Column A values
'If it's blank, take the value from the cell above
For i = 1 To lRow
If Cells(i, 1).Value = "" Then
Cells(i, 1).Value = Cells(i - 1, 1).Value
End If
Next i
End Sub

Sub CopyHeader()
Dim sw As Worksheet: Set sw = ThisWorkbook.Sheets("OriginalFunding") 'source worksheet
Dim tw As Worksheet: Set tw = ThisWorkbook.Sheets("FundingReturn") 'target worksheet
tw.Activate
'insert a blank row
tw.Range("A1").EntireRow.Insert
sw.Activate
Const WHAT_TO_FIND As String = "Learner"
Set FoundCell = sw.Range("A:A").Find(What:=WHAT_TO_FIND)
If Not FoundCell Is Nothing Then
sw.Rows(FoundCell.Row).EntireRow.Copy tw.Range("A1")
Else
MsgBox (WHAT_TO_FIND & " not found")
End If
End Sub

Sub DeleteFirstSheet()
'Check if the first sheet is called Sheet1
'If so, delete it.
Dim t As String
t = Sheets(1).Name
If t = "Sheet1" Then
Application.DisplayAlerts = False
Sheets(1).Delete
Application.DisplayAlerts = True
End If
Sheets(1).Name = "OriginalFunding"
End Sub

Private Sub CreateSheet()
Dim ws As Worksheet
With ThisWorkbook
Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
ws.Name = "FundingReturn"
End With
End Sub


Sub CopyAims()
Dim i As Long
Dim vLastRow As Long
Dim s2 As Long
Dim sw As Worksheet: Set sw = ThisWorkbook.Sheets("OriginalFunding") '<-- Update
Dim tw As Worksheet: Set tw = ThisWorkbook.Sheets("FundingReturn") '<-- Update
'Activate the source sheet
sw.Activate
'find last row in sheet, or you could change to find last row in specified column
'Example: Cells = Columns(column number or letter), Cells(1, 1) = Cells(1, column number)
vLastRow = Cells.Find(What:="*", After:=Cells(1, 1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row
s2 = 1
Application.ScreenUpdating = False
For i = 1 To vLastRow
If Trim(Len(CStr(Cells(i, 2)))) = 8 Then
Rows(i).EntireRow.Copy Destination:=tw.Range(Cells(s2, 1).Address)
s2 = s2 + 1
End If
Next i
Application.ScreenUpdating = True
End Sub




Thank you

Paul_Hossler
12-24-2018, 09:23 AM
Suggestions / personal style comments -- didn't test or check your logic

1. Use Option Explicit to require variable declaration

2. It seems that sw and tw should be declared at the module level and would be available to all procedures within that module

3. Since ValidateReturn() seems to be the main user-called sub, I prefer to put 'top level' code there, like ScreenUpdating and the Set's for global variables
4. The other subs appear to be not user callable, so making them Private will keep them off the Run Macros lists

5. Usually, it's not necessary to select an object to act on it

6. I personally avoid letting methods or properties default to (say) the Activesheet

So instead of just Cells(I,2).Value I use something like tw.Cells(I, 2).Value

Many times I've had a hard to track down bug, because a different sheet was active than the one I thought was

7. You can use With / End With to simplify the code

8. My style is to not put multiple statements on one line (e.g. Dim …. : Set …..). I find that harder to debug when stepping through a macro. Likewise I like to Dim all my variables in one place at the top

9. Finally, as you get more VBA experience, become familiar with the Excel object model so that you don't write a long complicated macro that the right call to the right Excel object can do easier and faster



This is just markup of the main and one supporting sub to show what I'm trying to say. I thought your macros were pretty good.



Option Explicit

'module level
Dim sw As Worksheet 'source worksheet
Dim tw As Worksheet 'target worksheet

Sub ValidateReturn()

Application.ScreenUpdating = False

Set sw = ThisWorkbook.Sheets("OriginalFunding") 'source worksheet
Set tw = ThisWorkbook.Sheets("FundingReturn") 'target worksheet

DeleteFirstSheet
CreateSheet
CopyAims
FillBlanks
SplitLearnerDetails

Application.ScreenUpdating = True
End Sub



Private Sub SplitLearnerDetails()
Dim substrings() As String
Dim i As Long, lrow As Long
' tw.Activate ' not required
With tw
.Range("A1").EntireColumn.Insert Shift:=xlToRight
.Range("A1").EntireColumn.Insert Shift:=xlToRight
.Range("A1").EntireColumn.Insert Shift:=xlToRight
lrow = .Cells(.Rows.Count, 4).End(xlUp).Row
For i = 1 To lrow
substrings = Split(.Cells(i, 4), " - ")
.Cells(i, 1).Value = substrings(0) & "-" & Cells(i, 5)
.Cells(i, 2).Value = substrings(0)
.Cells(i, 3).Value = substrings(1)
Next i
End With

End Sub

Ports
12-24-2018, 09:43 AM
Thank you very much. Much appreciated. Your feedback is very helpful. I'll go through it in detail and post if I have any further questions.