Hi All, Need help to copy the full row if Priority Level criteria matches (P1=Highest, P2, P3, P4 and P5=Lowest). Also column (A) Task having duplicate rows of same Task.
Till now i have written the code to copy the P1 data from sheet Data into another sheet name Data1 of workbook named SourceData using if condition. Facing issue while copying the data of P2,P3,P4 and P5 into another sheet Data1.
Below is the condition which i am following to paste the full data on the basis of priority level.
1. Suppose if Priority level is P1 or P2 or P3 or P4 or P5 then it should only copy full row of that priority level (P1) as it is highest level (other level (P2,P3,P4,P5 will not be consider as their priority level is lower than P1).
2. In the same, if Priority level is P2 and P1 is not present and other P3 or P4 or P5 is their then only P2 row will be copied and pasted to another sheet as P2 level is greater than P3,P4 and P5.
3. In the same way, if priority level P3 is present, and other P4 and P5 is also present, then P3 will be consider and full row will pasted and P4 and P5 level will not be copied.
4. In the same way, if priority level P4 is present, and other P5 is also present, then P4 will be consider and full row will pasted and P5 level will not be copied.
5. And lastly if P5 level is present then it will copy the P5 row into another sheet of data1
Find below code which i am using.
Source File name :- SourceData.xlsx
Macro File name:- TimeCalc.xlsb
Any suggestion or advise will be help full to me.
Thank you!!
Amit Singh
Why do You open a duplicate thread again and again and again?
Do not make more duplicates with this thread!
>>> as well as - - - - use code - tags <<<
Till now i have written the code to copy the P1 data from sheet Data into another sheet name Data1 of workbook named SourceData using if condition. Facing issue while copying the data of P2,P3,P4 and P5 into another sheet Data1
Below is the condition which i am following to paste the full data on the basis of priority level.
1. Suppose if Priority level is P1 or P2 or P3 or P4 or P5 then it should only copy full row of that priority level (P1) as it is highest level (other level (P2,P3,P4,P5 will not be consider as their priority level is lower than P1).
2. In the same, if Priority level is P2 and P1 is not present and other P3 or P4 or P5 is their then only P2 row will be copied and pasted to another sheet as P2 level is greater than P3,P4 and P5.
3. In the same way, if priority level P3 is present, and other P4 and P5 is also present, then P3 will be consider and full row will pasted and P4 and P5 level will not be copied.
4. In the same way, if priority level P4 is present, and other P5 is also present, then P4 will be consider and full row will pasted and P5 level will not be copied.
5. And lastly if P5 level is present then it will copy the P5 row into another sheet of data1
Find below code which i am using.
Source File name :- SourceData.xlsx
Macro File name:- TimeCalc.xlsb
Any suggestion or advise will be help full to me.
Thank you!!
Amit Singh
Why do You open a duplicate thread again and again and again?
Do not make more duplicates with this thread!
>>> as well as - - - - use code - tags <<<
Code:
Option Explicit
Sub Timecalculation()
Dim wb As Workbook
Dim wks As Worksheet
Dim objList As ListObject
Dim LastRow, Lsheet2 As Long
Dim sht As Worksheet
Dim myfile As Variant
Dim i, j As Integer
'code for opening excel file to process
myfile = Application.GetOpenFilename(Filefilter:="Excel Files,*.xl*;*.xm*")
If myfile <> False Then
Workbooks.Open Filename:=myfile
End If
'code for convereting table into Range
For Each wks In ActiveWorkbook.Worksheets
For Each objList In wks.ListObjects
objList.Unlist
Next objList
Next wks
Range("H1").Select
'Adding new sheet and copy header from Data sheet
Application.ScreenUpdating = False
Worksheets("Data").Activate
Rows("1:1").Select
Selection.Copy
Sheets.Add(After:=Sheets("Data")).Name = "Data1"
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
'code for copying full row basis of Priority level
Worksheets("Data").Activate
Range("A1").Select
LastRow = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LastRow
If Worksheets("Data").Cells(i, 8).Value = "P1" Then
Worksheets("Data").Rows(i).Copy
Worksheets("Data1").Activate
Lsheet2 = Worksheets("Data1").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Data1").Cells(Lsheet2 + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next i
Application.CutCopyMode = False
Range("A1").Select
Application.DisplayAlerts = False
End Sub
Attachments
Last edited by a moderator: