Find VPA by finding duplicate or non-duplicate rows (common or non-common) on a page and move values to a row on another Excel page :Thank you

[bahrami]

Find VPA by finding duplicate or non-duplicate rows (common or non-common) on a page and move values to a row on another Excel page :Thank you

Example file-01.xlsm
	A	B	C	D	E	F	G	H	I
1	Row	National Code	name	last name	Union name	Board code	Board code	Side	Election date
2	1	181-842934-9	Sasan	Bahrami	Tools Union	first round	1	First Vice President	1391/03/27
3	2	181-842934-9	Sasan	Bahrami	Tools Union	second period	2	Second Vice President	1395/02/26
4	3	181-842934-9	Sasan	Bahrami	Tools Union	second period	4	Secretary	1399/02/26
5	4	181-987654-3	Amir	Bahrami	Electric Trade Union	Fourth period	6	Inspector	1400/02/30
Sheet1

Example file-01.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Row	National Code	name	last name	Union name	Side of the first period	Date of the first period	Side of the second period	Date of the first period	Side of the Thirdperiod	Date of the Thirdperiod	Side of the Fourth period	Date of the Fourth period	Number of company courses in the board of directors
2	1	181-842934-9	Sasan	Bahrami	Tools Union	First Vice President	1391/03/27	Second Vice President	1395/02/26	Secretary	1399/02/26	0	0	3
3	2	181-987654-3	Amir	Bahrami	Electric Trade Union	0	0	0	0	0	0	Inspector	1400/02/30	1
Sheet2

 

[DanteAmor]

Some considerations that I see in your example that you should review in your data.

Here it should be "Third" And you have blank spaces before texts.

It says "Date of the first period", it should say "Date of the second period"
It says "Thirdperiod", it should say "Third period"

Note: If the quality of your data is better, you will have better results.

Try this

Sub reorganize()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim i As Long, lr As Long, n As Long
  Dim f As Range, c As Range
  Dim prd As String
 
  Application.ScreenUpdating = False
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  sh2.Rows("2:" & rows.count).ClearContents
 
  For i = 2 To sh1.Range("A" & Rows.Count).End(3).Row
    Set f = sh2.Range("B:B").Find(sh1.Range("B" & i).Value, , xlValues, xlWhole, , , False)
    If f Is Nothing Then
      n = n + 1
      lr = sh2.Range("A" & Rows.Count).End(3).Row + 1
      sh2.Range("A" & lr).Value = n
      sh2.Range("B" & lr).Resize(1, 4).Value = sh1.Range("B" & i).Resize(1, 4).Value
    Else
      lr = f.Row
    End If
    prd = WorksheetFunction.Trim(Split(WorksheetFunction.Trim(sh1.Range("F" & i).Value), " ")(0))
    Set c = sh2.Range("1:1").Find(prd, , xlValues, xlPart, , , False)
    If Not c Is Nothing Then
      sh2.Cells(lr, c.Column).Resize(1, 2).Value = sh1.Range("H" & i).Resize(1, 2).Value
    End If
    sh2.Range("N" & lr).Value = sh2.Range("N" & lr).Value + 1
  Next
  Application.ScreenUpdating = True
End Sub

 

[bahrami]

Using VBA to find duplicate or non-duplicate rows (common or non-common) in sheet 1 and move to sheet 2 in a row​

A table in sheet one contains the names of duplicate and non-duplicate persons who have participated in the union elections in consecutive or alternate terms for four years and all have different positions and positions. Courses and dates have participated in the elections and at the end, the number of participants in the elections should be added.

Example file-05.xlsm
	A	B	C	D	E	F	G	H	I
1	Row	National Code	name	last name	Union name	Election period	Board position code	Side	Election date
2	1	181-842934-9	Sasan	Bahrami	Tools Union	first round	1	First Vice President	1391/03/27
3	2	181-842934-9	Sasan	Bahrami	Tools Union	second period	2	Second Vice President	1395/02/26
4	3	181-842934-9	Sasan	Bahrami	Tools Union	second period	4	Secretary	1399/02/26
5	4	181-987654-3	Amir	Bahrami	Electric Trade Union	Fourth period	6	Inspector	1400/02/30
6
Sheet1

Example file-05.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Personal profile					The first round of elections		The second round of elections		The third round of elections		The fourth round of elections		Number of periods of participation in elections
2	Row	National Code	Name	Last name	Union name	Side Election Date	Election Date	Side Election Date	Election Date	Side Election Date	Election Date	Side of the Fourth period	Date of the Fourth period
3	1	181-842934-9	Sasan	Bahrami	Tools Union	First Vice President	1391/03/27	Second Vice President	1395/02/26	Secretary	1399/02/26	0	0	3
4	2	181-987654-3	Amir	Bahrami	Electric Trade Union	0	0	0	0	0	0	Inspector	1400/02/30	1
Sheet2

 

[DanteAmor]

Did you try the code of post #2?

 

[bahrami]

Hello, good day, use the code you used for another topic that is similar and written, and complete the elections of each period (position and date) for the first, second, third and fourth elections, respectively. Thank you.
Sub remove_duplicates_leave_unique()
Dim a As Variant, b As Variant
Dim dic As Object
Dim i As Long, j As Long

Set dic = CreateObject("Scripting.Dictionary")
a = Sheets("Sheet1").Range("A2", Sheets("Sheet1").Range("i" & Rows.Count).End(3)).Value
ReDim b(1 To UBound(a, 1), 1 To 10)

For i = 1 To UBound(a)
If Not dic.exists(a(i, 9)) Then
j = dic.Count + 1
dic(a(i, 5)) = j
b(j, 1) = j
b(j, 2) = a(i, 2)
b(j, 3) = a(i, 3)
b(j, 4) = a(i, 4)
b(j, 5) = a(i, 5)
b(j, 6) = a(i, 6)
b(j, 7) = a(i, 7)
b(j, 8) = a(i, 8)
b(j, 9) = a(i, 9)
Else
j = dic(a(i, 5))
End If
b(j, 10) = b(j, 10) + 1
Next
Sheets("Sheet2").Range("A2").Resize(dic.Count, 10).Value = b
Sheet2.Columns().AutoFit
End Sub

 

[bahrami]

Hi, I used your codes, but the title and date of the election will not be transferred to sheet 2, and if it is transferred, the last title and date of the election will be transferred. Thank you for your help and support

 

[bahrami]

Some considerations that I see in your example that you should review in your data.

Here it should be "Third" And you have blank spaces before texts.
View attachment 60600

It says "Date of the first period", it should say "Date of the second period"
It says "Thirdperiod", it should say "Third period"
View attachment 60601

Note: If the quality of your data is better, you will have better results.

Try this

Sub reorganize()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim i As Long, lr As Long, n As Long
  Dim f As Range, c As Range
  Dim prd As String
 
  Application.ScreenUpdating = False
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  sh2.Rows("2:" & rows.count).ClearContents
 
  For i = 2 To sh1.Range("A" & Rows.Count).End(3).Row
    Set f = sh2.Range("B:B").Find(sh1.Range("B" & i).Value, , xlValues, xlWhole, , , False)
    If f Is Nothing Then
      n = n + 1
      lr = sh2.Range("A" & Rows.Count).End(3).Row + 1
      sh2.Range("A" & lr).Value = n
      sh2.Range("B" & lr).Resize(1, 4).Value = sh1.Range("B" & i).Resize(1, 4).Value
    Else
      lr = f.Row
    End If
    prd = WorksheetFunction.Trim(Split(WorksheetFunction.Trim(sh1.Range("F" & i).Value), " ")(0))
    Set c = sh2.Range("1:1").Find(prd, , xlValues, xlPart, , , False)
    If Not c Is Nothing Then
      sh2.Cells(lr, c.Column).Resize(1, 2).Value = sh1.Range("H" & i).Resize(1, 2).Value
    End If
    sh2.Range("N" & lr).Value = sh2.Range("N" & lr).Value + 1
  Next
  Application.ScreenUpdating = True
End Sub

 

[bahrami]

Hello, please check my message if possible. This is important to me.