Help

[flopodopolis1]

Code is running slow any tips

Sub project1()
 
Dim g As Integer
Dim del_cancelreq As String
Dim del_cancel As String
Dim del_finished As String
Dim ER As Long
Dim TheDate As Date
 
Rows1 = Sheet1.Cells(1, 1).CurrentRegion.Rows.Count
ColS1 = Sheet1.Cells(1, 1).CurrentRegion.Columns.Count
ColS2 = Sheet2.Cells(1, 1).CurrentRegion.Columns.Count
RowS2 = Sheet2.Cells(1, 1).CurrentRegion.Rows.Count
 
 
 
plcode = "PL11"
plcode2 = "PL12"
plcode3 = "PL13"
del_cancelreq = "CXCL/REQ"
del_cancel = "CANCELED"
del_finished = "FINISHED"
TheDate = Now
 
If MsgBox("Do you wish to update workscope", vbYesNo) = vbNo Then Exit Sub
 
For Rw = Rows1 To 1 Step by - 1 'ISSUE WITH THE WOC NUMBER 11049003
   
   If Sheet1.Cells(Rw, 27) = plcode Or Sheet1.Cells(Rw, 27) = plcode2 Or Sheet1.Cells(Rw, 27) = plcode3 Then
       For CL = 1 To ColS1
           Sheet2.Cells(RowS2, CL) = Sheet1.Cells(Rw, CL)
           Sheet2.Cells(RowS2, 28) = TheDate
           
           Next CL
           
           RowS2 = RowS2 + 1
   End If
Next Rw
 
 
Worksheets("Workscope").Select ' removal of dublicates
ER = Range("A1").End(xlDown).Row 'if array 6 changes then array 5 and 6 will delete new updated version !needfix!
Columns("A:AB").Select
ActiveSheet.Range("A1:AB" & ER).RemoveDuplicates Columns:=Array(4, 5) 'got sheet referancing and the remove duplicate help of the internet
 
For g = RowS2 To 1 Step -1 'delete the rows from bottom up as doing it from the top caused issues unsure why this fixed it
   If Sheet2.Cells(g, 7) = del_cancel Or Sheet2.Cells(g, 7) = del_cancelreq Or Sheet2.Cells(g, 7) = del_finished Then
           Sheet2.Rows(g).Delete
           RowS2 = RowS2 + 1
           
   End If
Next g
 
MsgBox ("Workscope has been updated, please now press Update Status button")
 
End Sub
Sub test100()
 
Dim g As Integer
Dim del_cancelreq As String
Dim del_cancel As String
Dim del_finished As String
Dim ER As Long
Dim TheDate As Date
 
Rows1 = Sheet1.Cells(1, 1).CurrentRegion.Rows.Count
ColS1 = Sheet1.Cells(1, 1).CurrentRegion.Columns.Count
ColS2 = Sheet2.Cells(1, 1).CurrentRegion.Columns.Count
RowS2 = Sheet2.Cells(1, 1).CurrentRegion.Rows.Count
RowS3 = Sheet3.Cells(1, 1).CurrentRegion.Rows.Count
RowS3 = Sheet3.Cells(1, 1).CurrentRegion.Columns.Count
 
 
 
plcode = "PL11"
plcode2 = "PL12"
plcode3 = "PL13"
del_cancelreq = "CXCL/REQ"
del_cancel = "CANCELED"
del_finished = "FINISHED"
TheDate = Now
 
For Rw = Rows1 To 1 Step by - 1
   
   If Sheet1.Cells(Rw, 27) = plcode Or Sheet1.Cells(Rw, 27) = plcode2 Or Sheet1.Cells(Rw, 27) = plcode3 Then
       For CL = 1 To ColS1
           Sheet3.Cells(RowS3, CL) = Sheet1.Cells(Rw, CL)
           Next CL
           
           RowS3 = RowS3 + 1
   End If
Next Rw
 
For g = RowS3 To 1 Step -1
   If Sheet3.Cells(g, 7) = del_cancel Or Sheet3.Cells(g, 7) = del_cancelreq Or Sheet3.Cells(g, 7) = del_finished Then
           Sheet3.Rows(g).Delete
           RowS3 = RowS3 + 1
           
   End If
Next g
 
Call test2
 
End Sub
Sub test2()
 
Rows1 = Sheet1.Cells(1, 1).CurrentRegion.Rows.Count
RowS3 = Sheet3.Cells(1, 1).CurrentRegion.Rows.Count
ColS1 = Sheet1.Cells(1, 1).CurrentRegion.Columns.Count
ColS2 = Sheet2.Cells(1, 1).CurrentRegion.Columns.Count
RowS2 = Sheet2.Cells(1, 1).CurrentRegion.Rows.Count
 
If MsgBox("Have you updated workscope before this?", vbYesNo) = vbNo Then Exit Sub
 
MsgBox ("This may take a few seconds")
   
   Sheet2.Select
 
   For i = RowS2 To 1 Step by - 1
A = Cells(RowS2, 4)
B = Cells(RowS2, 5)
Cells(RowS2, 38) = A & B
 
RowS2 = RowS2 - 1
   Next i
   
   Sheet3.Select
   
   For k = RowS3 To 1 Step by - 1
A = Cells(RowS3, 4)
B = Cells(RowS3, 5)
Cells(RowS3, 38) = A & B
 
RowS3 = RowS3 - 1
   Next k
   
Call Match
   
End Sub
 
Sub Match()
Rows1 = Sheet1.Cells(1, 1).CurrentRegion.Rows.Count
RowS3 = Sheet3.Cells(1, 1).CurrentRegion.Rows.Count
ColS1 = Sheet1.Cells(1, 1).CurrentRegion.Columns.Count 
ColS2 = Sheet2.Cells(1, 1).CurrentRegion.Columns.Count
RowS2 = Sheet2.Cells(1, 1).CurrentRegion.Rows.Count
 
   For j = RowS2 To 1 Step by - 1
       For h = RowS3 To 1 Step by - 1
       If Cells(h, 38) = Cells(j, 38) Then
       Sheet2.Cells(j, 7) = Sheet3.Cells(h, 7)
       Sheet2.Cells(j, 6) = Sheet3.Cells(h, 6)
       End If
       Next h
   Next j
 
Sheet3.Cells.Clear
 
MsgBox ("Status's have been updated")
   
End Sub

 

[NdNoviceHlp]

Please be provide more information both within the topic of your thread and within the question itself. What are U trying to accomplish? Where is the input data, what do U want to do with it and where do U want to store it when you're done? Please be specific with sheet, column and row locations. Also, please use code tags. As far as speeding things up, your code is repetitive, uses unnecessary selections and accesses the sheet frequently. Code execution speed can also be improved by managing screenupdating, calculations, etc. Speed also depends on just how much data you're working with so it would probably be good to know that as well. HTH. Dave

 

[Fluff]

@flopodopolis1

In future, when posting code please use code tags, that's the # icon in the reply window.