Hi Everyone!
Happy New Year!
I am trying to make my VBA faster - It is pretty slow for now (30 secs)
If anyone can help me on how Im approaching my loops Ill be grateful![/FONT]
Happy New Year!
I am trying to make my VBA faster - It is pretty slow for now (30 secs)
Code:
<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px 'Helvetica Neue'}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px 'Helvetica Neue'; min-height: 14.0px}</style>Function GetWorksheet(shtName As String) As Worksheet
On Error Resume Next
Set GetWorksheet = Worksheets(shtName)
End Function
Sub recon()
Dim i As Long
i = 2
'To search for additional sheet created in previous run and delete it
For Each ws In Worksheets
If ws.Name = "RECONCILE" Then
Application.DisplayAlerts = False
Sheets("RECONCILE").Delete
Application.DisplayAlerts = True
End If
'Delete sheet from finance if it exists
If Not GetWorksheet("Working") Is Nothing Then
Application.DisplayAlerts = False
Sheets("Working").Delete
Application.DisplayAlerts = True
End If
Next
Worksheets("CBS").Columns(11).NumberFormat = "0"
Worksheets("CBS").Range("A1").AutoFilter Field:=2, Criteria1:="M2URPN"
If Worksheets("M2URPN").Range("A1") = "1MAYBANK" Then
Worksheets("M2URPN").Rows("1:3").EntireRow.Delete
End If
Sheets("M2URPN").Select
Do While i <= ThisWorkbook.ActiveSheet.Range("A2").CurrentRegion.Rows.Count
If InStr(1, ThisWorkbook.ActiveSheet.Cells(i, 1).Text, "1MAYBANK", vbTextCompare) > 0 Or _
InStr(1, ThisWorkbook.ActiveSheet.Cells(i, 1).Text, "DEPT", vbTextCompare) > 0 Or _
InStr(1, ThisWorkbook.ActiveSheet.Cells(i, 1).Text, "0PAYEE", vbTextCompare) > 0 Or _
InStr(1, ThisWorkbook.ActiveSheet.Cells(i, 1).Text, "0NAME", vbTextCompare) > 0 Then
ThisWorkbook.ActiveSheet.Cells(i, 1).EntireRow.Delete
Else
i = i + 1
End If
Loop
Worksheets("M2URPN").Columns(4).NumberFormat = "0"
If Worksheets("M2URPN").Cells(Rows.Count, 1).End(xlUp).Value = "-*** END OF REPORT ***" Then
With Worksheets("M2URPN")
.Cells(Rows.Count, "A").End(xlUp). _
Offset(-34).Resize(35).EntireRow.Delete
End With
End If
Worksheets("CBS").Range("K:K").Copy Destination:=Worksheets("M2URPN").Range("H1")
Worksheets("CBS").Range("R:R").Copy Destination:=Worksheets("M2URPN").Range("I1")
Worksheets("CBS").Range("Q:Q").Copy Destination:=Worksheets("M2URPN").Range("J1")
Worksheets("M2URPN").Range("G2").FormulaR1C1 = "Type"
Worksheets("CBS").Columns("A:Z").AutoFit
Worksheets("M2URPN").Columns("A:Z").AutoFit
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "RECONCILE"
Call M2UMissing
' Call CBSMissing
MsgBox "Data Magic for Amelia is Done"
End Sub
Sub M2UMissing()
Dim i As Long, _
LRa As Long, _
LRb As Long, _
rowx As Long
LRa = Range("I" & Rows.Count).End(xlUp).Row
LRb = Range("F" & Rows.Count).End(xlUp).Row
rowx = 2
Application.ScreenUpdating = False
For i = 2 To LRa
If IsError(Application.Match(Range("I" & i).Value, Range("F2:F" & LRb), 0)) Then
Range("O" & rowx).Value = Range("F" & i).Value
rowx = rowx + 1
End If
Next i
rowx = 2
For i = 2 To LRb
If IsError(Application.Match(Range("F" & i).Value, Range("I2:I" & LRa), 0)) Then
Range("S" & rowx).Value = Range("I" & i).Value
rowx = rowx + 1
End If
Next i
Worksheets("M2URPN").Range("O1") = "MISSING IN CBS"
Worksheets("M2URPN").Range("S1") = "MISSING IN M2U"
Sheets("M2URPN").Columns(15).Cut Destination:=Sheets("RECONCILE").Columns(1)
Sheets("M2URPN").Columns(19).Cut Destination:=Sheets("RECONCILE").Columns(5)
Application.ScreenUpdating = True
End Sub
Sub ssss()
'Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row).FillDown
Application.ScreenUpdating = False
Columns(6).Cut
Columns(1).Insert Shift:=xlToRight
Columns(9).Cut
Columns(8).Insert Shift:=xlToRight
Application.ScreenUpdating = True
End Sub
[FONT=Verdana]
If anyone can help me on how Im approaching my loops Ill be grateful![/FONT]