I have a macro which searches through all the rows one sheet and copies each row to another sheet dependant upon the value in a particular cell (quite proud of this as it took me a while to get it working).
The macro runs very slowly though flickering between sheets. Is there some way I can improve the performance of the macro or is there a better way of doing what I am trying to do?
'Start search in row 3
LSearchRow = 3
'Start copying data to row 2 in appropriate sheet (row counter variable)
LCopyToRowIP = 2
LCopyToRowPQE = 2
LCopyToRowIRR = 2
LCopyToRowPC = 2
LCopyToRowIPROD = 2
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
'If to select row from Input Data sheet and copy into appropriate sheet
If Range("C" & CStr(LSearchRow)).Value = "In Process" Then
'Copy row from Input Data sheet to In Process Sheet
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy
Worksheets("In Process").Rows(CStr(LCopyToRowIP) & ":" & CStr(LCopyToRowIP)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Move counter to next row
LCopyToRowIP = LCopyToRowIP + 1
ElseIf Range("C" & CStr(LSearchRow)).Value = "Poor Quality Effluent" Then
'Copy row from Input Data sheet to Poor Effluent Quality Sheet
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy
Worksheets("Poor Quality Effluent").Rows(CStr(LCopyToRowIP) & ":" & CStr(LCopyToRowIP)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Move counter to next row
LCopyToRowPQE = LCopyToRowPQE + 1
ElseIf Range("C" & CStr(LSearchRow)).Value = "Irrigation" Then
'Copy row from Input Data sheet to Irrigation sheet
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy
Worksheets("Irrigation").Rows(CStr(LCopyToRowIP) & ":" & CStr(LCopyToRowIP)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Move counter to next row
LCopyToRowIRR = LCopyToRowIRR + 1
ElseIf Range("C" & CStr(LSearchRow)).Value = "Process Cooling" Then
'Copy row from Input Data sheet to In Process Cooling sheet
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy
Worksheets("Process Cooling").Rows(CStr(LCopyToRowIP) & ":" & CStr(LCopyToRowIP)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Move counter to next row
LCopyToRowPC = LCopyToRowPC + 1
ElseIf Range("C" & CStr(LSearchRow)).Value = "In Product" Then
'Copy row from Input Data sheet to In Product sheet
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy
Worksheets("In Product").Rows(CStr(LCopyToRowIP) & ":" & CStr(LCopyToRowIP)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Move counter to next row
LCopyToRowIPROD = LCopyToRowIPROD + 1
End If
LSearchRow = LSearchRow + 1
Bookmarks