Filtering data depending on a specific column
-
- 2StarLounger
- Posts: 182
- Joined: 24 Jan 2019, 10:58
Filtering data depending on a specific column
Hello everyone
I have this attachment that Transfer specific columns from one sheet into two sheets Depending on two condition in the column k in source sheet to sheets " main store & Another stores " It works very well....but I need to filter the data In both of the two sheets " main store & Another stores " Depending on the column L in source sheet, I tried to apply the solution but could not do that. Please see what I want to achieve in this example. I'd be grateful for some support.
I have posted the same thread at this link
https://www.excelforum.com/excel-progra ... ost5258664" onclick="window.open(this.href);return false;
Thank you
I have this attachment that Transfer specific columns from one sheet into two sheets Depending on two condition in the column k in source sheet to sheets " main store & Another stores " It works very well....but I need to filter the data In both of the two sheets " main store & Another stores " Depending on the column L in source sheet, I tried to apply the solution but could not do that. Please see what I want to achieve in this example. I'd be grateful for some support.
I have posted the same thread at this link
https://www.excelforum.com/excel-progra ... ost5258664" onclick="window.open(this.href);return false;
Thank you
You do not have the required permissions to view the files attached to this post.
-
- Administrator
- Posts: 78686
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Filtering data depending on a specific column
You haven't explained how or what you want to filter.
Best wishes,
Hans
Hans
-
- 2StarLounger
- Posts: 182
- Joined: 24 Jan 2019, 10:58
Re: Filtering data depending on a specific column
Thanks a lot Mr. Hans
I need to transfer data to both sheets "main store & Another stores" if condition is met in column L I think I need to add another condition to achieve this
Thank you very much in advance.
I need to transfer data to both sheets "main store & Another stores" if condition is met in column L I think I need to add another condition to achieve this
Thank you very much in advance.
-
- Administrator
- Posts: 78686
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Filtering data depending on a specific column
But which condition in column L?
Best wishes,
Hans
Hans
-
- 2StarLounger
- Posts: 182
- Joined: 24 Jan 2019, 10:58
Re: Filtering data depending on a specific column
The condition is ( the payment was made ) in column L in source sheet.
-
- Administrator
- Posts: 78686
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Filtering data depending on a specific column
Why didn't you mention that in the first post?
Try this version:
Try this version:
Code: Select all
Sub VBAArrayTypeAlternativeToFilter()
' Worksheets
Dim wS As Worksheet
Dim wM As Worksheet
Dim wA As Worksheet
' Range Info
Dim m As Long
Dim arrK As Variant
' Indices needed for output arrays
Dim strMain As String, strAnother As String
Dim cnt As Long
Dim clms As Variant
Dim strRws() As String
Dim Rws() As String
Dim arrOut As Variant
Set wS = Worksheets("Source")
Set wM = Worksheets("Main Store")
Set wA = Worksheets("Another Stores")
m = wS.Range("A" & Rows.Count & "").End(xlUp).Row
arrK = wS.Range("K1:L" & m).Value
strMain = "7"
strAnother = "7"
For cnt = 8 To m
If arrK(cnt, 2) Like "*payment was made" Then
If arrK(cnt, 1) = "main store" Then
strMain = strMain & " " & cnt
Else
strAnother = strAnother & " " & cnt
End If
End If
Next cnt
'Output Main Store
clms = Array(1, 4, 6, 13, 14)
strRws = Split(strMain)
ReDim Rws(1 To UBound(strRws) + 1, 1 To 1)
For cnt = 1 To UBound(strRws) + 1
Rws(cnt, 1) = strRws(cnt - 1)
Next cnt
arrOut = Application.Index(wS.Cells, Rws, clms)
With wM.Range("A13").Resize(UBound(arrOut, 1), UBound(arrOut, 2))
.Value = arrOut
.Sort Key1:=wM.Range("C13"), Header:=True
.Font.Name = "Times New Roman"
.Font.Size = 13
.RowHeight = 17
End With
'Output Another Stores
clms = Array(1, 4, 6, 13, 14)
strRws = Split(strAnother)
ReDim Rws(1 To UBound(strRws, 1) + 1, 1 To 1)
For cnt = 1 To UBound(strRws, 1) + 1
Rws(cnt, 1) = strRws(cnt - 1)
Next cnt
arrOut = Application.Index(wS.Cells, Rws, clms)
With wA.Range("A13").Resize(UBound(arrOut, 1), UBound(arrOut, 2))
.Value = arrOut
.Sort Key1:=wA.Range("C13"), Header:=True
.Font.Name = "Times New Roman"
.Font.Size = 13
.RowHeight = 17
End With
End Sub
Best wishes,
Hans
Hans
-
- 2StarLounger
- Posts: 182
- Joined: 24 Jan 2019, 10:58
Re: Filtering data depending on a specific column
In fact Mr Hans It is greater than I imagined. Thank you very very much for that Genius solution
I have three additions to adjust the two sheets " main store & Another stores ".
Please accept my apologies for these additions, but I tried However failed to achieve it.
Additions as follows:-
1- I need to be divided each 27 rows from the Start of row 19
2- add strings As the signatures of the officials like "Deputy Director / General Director"... below the tables.
3- Adjust page breaks.
Please see the attachment for a sample of the data and the desired output.
Have a nice time my Professor, Thank you in advance
I have three additions to adjust the two sheets " main store & Another stores ".
Please accept my apologies for these additions, but I tried However failed to achieve it.
Additions as follows:-
1- I need to be divided each 27 rows from the Start of row 19
2- add strings As the signatures of the officials like "Deputy Director / General Director"... below the tables.
3- Adjust page breaks.
Please see the attachment for a sample of the data and the desired output.
Have a nice time my Professor, Thank you in advance
You do not have the required permissions to view the files attached to this post.
-
- Administrator
- Posts: 78686
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Filtering data depending on a specific column
See the attached version. I had to clear the Print Area of the Main Store and Another Stores sheets.
Code: Select all
Sub VBAArrayTypeAlternativeToFilter()
' Worksheets
Dim wS As Worksheet
Dim wM As Worksheet
Dim wA As Worksheet
' Range Info
Dim m As Long
Dim arrK As Variant
' Indices needed for output arrays
Dim strMain As String, strAnother As String
Dim cnt As Long
Dim clms As Variant
Dim strRws() As String
Dim Rws() As String
Dim arrOut As Variant
Dim i As Long
Dim r As Long
Dim n As Long
Set wS = Worksheets("Source")
Set wM = Worksheets("Main Store")
Set wA = Worksheets("Another Stores")
m = wS.Range("A" & Rows.Count & "").End(xlUp).Row
arrK = wS.Range("K1:L" & m).Value
strMain = "7"
strAnother = "7"
For cnt = 8 To m
If arrK(cnt, 2) Like "*payment was made" Then
If arrK(cnt, 1) = "main store" Then
strMain = strMain & " " & cnt
Else
strAnother = strAnother & " " & cnt
End If
End If
Next cnt
'Output Main Store
clms = Array(1, 4, 6, 13, 14)
strRws = Split(strMain)
ReDim Rws(1 To UBound(strRws) + 1, 1 To 1)
For cnt = 1 To UBound(strRws) + 1
Rws(cnt, 1) = strRws(cnt - 1)
Next cnt
arrOut = Application.Index(wS.Cells, Rws, clms)
wM.Activate
wM.Range("19:" & wM.Rows.Count).Clear
wM.Range("19:" & wA.Rows.Count).Delete
m = UBound(arrOut, 1)
With wM.Range("A18").Resize(UBound(arrOut, 1), UBound(arrOut, 2))
.Value = arrOut
.Sort Key1:=wM.Range("C18"), Header:=True
End With
For i = Application.Ceiling(m / 27, 1) To 1 Step -1
r = 19 + 27 * i
wM.Range("A" & r).EntireRow.Insert
wM.Range("B" & r).Value = "Deputy Director"
wM.Range("D" & r).Value = "General Director"
wM.HPageBreaks.Add wM.Range("A" & r + 1)
Next i
n = wM.Range("B" & wM.Rows.Count).End(xlUp).Row
With wM.Range("A18:E" & n)
.Borders.LineStyle = xlContinuous
.Font.Name = "Times New Roman"
.Font.Size = 13
.RowHeight = 17
End With
'Output Another Stores
clms = Array(1, 4, 6, 13, 14)
strRws = Split(strAnother)
ReDim Rws(1 To UBound(strRws, 1) + 1, 1 To 1)
For cnt = 1 To UBound(strRws, 1) + 1
Rws(cnt, 1) = strRws(cnt - 1)
Next cnt
arrOut = Application.Index(wS.Cells, Rws, clms)
wA.Activate
wA.Range("19:" & wA.Rows.Count).Delete
m = UBound(arrOut, 1)
With wA.Range("A18").Resize(m, UBound(arrOut, 2))
.Value = arrOut
.Sort Key1:=wA.Range("C18"), Header:=True
End With
For i = Application.Ceiling(m / 27, 1) To 1 Step -1
r = 19 + 27 * i
wA.Range("A" & r).EntireRow.Insert
wA.Range("B" & r).Value = "Deputy Director"
wA.Range("D" & r).Value = "General Director"
wA.HPageBreaks.Add wA.Range("A" & r + 1)
Next i
n = wA.Range("B" & wA.Rows.Count).End(xlUp).Row
With wA.Range("A18:E" & n)
.Borders.LineStyle = xlContinuous
.Font.Name = "Times New Roman"
.Font.Size = 13
.RowHeight = 17
End With
End Sub
You do not have the required permissions to view the files attached to this post.
Best wishes,
Hans
Hans
-
- 2StarLounger
- Posts: 182
- Joined: 24 Jan 2019, 10:58
Re: Filtering data depending on a specific column
Thank you Mr. Hans, for this great support
Please, we will need to adjust two points
The first point is : I need to add strings As the signatures of the officials below the tables, without border
The second point is : I tested the code on original data ( about 25000 rows ) and found it great and working very well but it took some time.
Is there any other additions to make it faster?
Thank you very much in advance.
Please, we will need to adjust two points
The first point is : I need to add strings As the signatures of the officials below the tables, without border
The second point is : I tested the code on original data ( about 25000 rows ) and found it great and working very well but it took some time.
Is there any other additions to make it faster?
Thank you very much in advance.
-
- Administrator
- Posts: 78686
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Filtering data depending on a specific column
What do you want to change for this? "I need to add strings As the signatures of the officials below the tables, without border"
Best wishes,
Hans
Hans
-
- 2StarLounger
- Posts: 182
- Joined: 24 Jan 2019, 10:58
Re: Filtering data depending on a specific column
There is no change... but one row should be inserted between tables without borders... that's what I mean
-
- Administrator
- Posts: 78686
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Filtering data depending on a specific column
Here is a new version. You'll have to live with the code being slow.
Code: Select all
Sub VBAArrayTypeAlternativeToFilter()
' Worksheets
Dim wS As Worksheet
Dim wM As Worksheet
Dim wA As Worksheet
' Range Info
Dim m As Long
Dim arrK As Variant
' Indices needed for output arrays
Dim strMain As String, strAnother As String
Dim cnt As Long
Dim clms As Variant
Dim strRws() As String
Dim Rws() As String
Dim arrOut As Variant
Dim i As Long
Dim r As Long
Dim n As Long
Set wS = Worksheets("Source")
Set wM = Worksheets("Main Store")
Set wA = Worksheets("Another Stores")
m = wS.Range("A" & Rows.Count & "").End(xlUp).Row
arrK = wS.Range("K1:L" & m).Value
strMain = "7"
strAnother = "7"
For cnt = 8 To m
If arrK(cnt, 2) Like "*payment was made" Then
If arrK(cnt, 1) = "main store" Then
strMain = strMain & " " & cnt
Else
strAnother = strAnother & " " & cnt
End If
End If
Next cnt
'Output Main Store
clms = Array(1, 4, 6, 13, 14)
strRws = Split(strMain)
ReDim Rws(1 To UBound(strRws) + 1, 1 To 1)
For cnt = 1 To UBound(strRws) + 1
Rws(cnt, 1) = strRws(cnt - 1)
Next cnt
arrOut = Application.Index(wS.Cells, Rws, clms)
wM.Activate
wM.Range("19:" & wM.Rows.Count).Clear
wM.Range("19:" & wM.Rows.Count).Delete
m = UBound(arrOut, 1)
With wM.Range("A18").Resize(UBound(arrOut, 1), UBound(arrOut, 2))
.Value = arrOut
.Sort Key1:=wM.Range("C18"), Header:=True
.Borders.LineStyle = xlContinuous
End With
For i = Application.Ceiling(m / 27, 1) To 1 Step -1
r = 19 + 27 * i
wM.Range("A" & r).EntireRow.Insert
wM.Range("A" & r).Resize(1, 5).Borders(xlInsideVertical).LineStyle = xlLineStyleNone
wM.Range("B" & r).Value = "Deputy Director"
wM.Range("D" & r).Value = "General Director"
wM.HPageBreaks.Add wM.Range("A" & r + 1)
Next i
n = wM.Range("B" & wM.Rows.Count).End(xlUp).Row
With wM.Range("A18:E" & n)
.Font.Name = "Times New Roman"
.Font.Size = 13
.RowHeight = 17
End With
'Output Another Stores
clms = Array(1, 4, 6, 13, 14)
strRws = Split(strAnother)
ReDim Rws(1 To UBound(strRws, 1) + 1, 1 To 1)
For cnt = 1 To UBound(strRws, 1) + 1
Rws(cnt, 1) = strRws(cnt - 1)
Next cnt
arrOut = Application.Index(wS.Cells, Rws, clms)
wA.Activate
wA.Range("19:" & wM.Rows.Count).Clear
wA.Range("19:" & wM.Rows.Count).Delete
m = UBound(arrOut, 1)
With wA.Range("A18").Resize(m, UBound(arrOut, 2))
.Value = arrOut
.Sort Key1:=wA.Range("C18"), Header:=True
.Borders.LineStyle = xlContinuous
End With
For i = Application.Ceiling(m / 27, 1) To 1 Step -1
r = 19 + 27 * i
wA.Range("A" & r).EntireRow.Insert
wM.Range("A" & r).Resize(1, 5).Borders(xlInsideVertical).LineStyle = xlLineStyleNone
wA.Range("B" & r).Value = "Deputy Director"
wA.Range("D" & r).Value = "General Director"
wA.HPageBreaks.Add wA.Range("A" & r + 1)
Next i
n = wA.Range("B" & wA.Rows.Count).End(xlUp).Row
With wA.Range("A18:E" & n)
.Font.Name = "Times New Roman"
.Font.Size = 13
.RowHeight = 17
End With
End Sub
Best wishes,
Hans
Hans
-
- 2StarLounger
- Posts: 182
- Joined: 24 Jan 2019, 10:58
Re: Filtering data depending on a specific column
Thanks a lot Mr. Hans for your patience in solving that issue
Same problem in this line of code
I will explain in another way
the previous page ends with border and the following page starts with border while this inserted row left without borders.
How can this line be modified... Thank you so much for all your assistance!
Same problem in this line of code
Code: Select all
wM.Range("A" & r).Resize(1, 5).Borders(xlInsideVertical).LineStyle = xlLineStyleNone
the previous page ends with border and the following page starts with border while this inserted row left without borders.
How can this line be modified... Thank you so much for all your assistance!
-
- Administrator
- Posts: 78686
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Filtering data depending on a specific column
Please explain what you actually want. It's not clear to me yet.
Best wishes,
Hans
Hans
-
- 2StarLounger
- Posts: 182
- Joined: 24 Jan 2019, 10:58
Re: Filtering data depending on a specific column
Thank you very much Mr. Hans
Everything is okay except for one point, I want to be able to insert empty row without borders after each 27 rows to add some Text strings
like "Deputy Director / General Director"... below the tables ( it has already been done )
With a note. if there is remain for example 4, then to put borders to suit the 27 records and let other 23 records empty but with the borders existing
Hope it is clear. Thank you so much for all your assistance!
Everything is okay except for one point, I want to be able to insert empty row without borders after each 27 rows to add some Text strings
like "Deputy Director / General Director"... below the tables ( it has already been done )
With a note. if there is remain for example 4, then to put borders to suit the 27 records and let other 23 records empty but with the borders existing
Hope it is clear. Thank you so much for all your assistance!
-
- Administrator
- Posts: 78686
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Filtering data depending on a specific column
But the inserted row doesn't have borders between the cells...
Best wishes,
Hans
Hans
-
- 2StarLounger
- Posts: 182
- Joined: 24 Jan 2019, 10:58
Re: Filtering data depending on a specific column
Yes sir, but only on the first page of a sheet "main store" As for the sheet other stores, nothing.
Please note the yellow rows in this example,Thank you in advance again
Please note the yellow rows in this example,Thank you in advance again
You do not have the required permissions to view the files attached to this post.
-
- Administrator
- Posts: 78686
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Filtering data depending on a specific column
The macro in your sample workbook is not the most recent one that I posted! But here is yet another version:
Code: Select all
Sub VBAArrayTypeAlternativeToFilter()
' Worksheets
Dim wS As Worksheet
Dim wM As Worksheet
Dim wA As Worksheet
' Range Info
Dim m As Long
Dim arrK As Variant
' Indices needed for output arrays
Dim strMain As String, strAnother As String
Dim cnt As Long
Dim clms As Variant
Dim strRws() As String
Dim Rws() As String
Dim arrOut As Variant
Dim i As Long
Dim r As Long
Dim n As Long
Dim c As Range
Dim a As String
Set wS = Worksheets("Source")
Set wM = Worksheets("Main Store")
Set wA = Worksheets("Another Stores")
m = wS.Range("A" & Rows.Count & "").End(xlUp).Row
arrK = wS.Range("K1:L" & m).Value
strMain = "7"
strAnother = "7"
For cnt = 8 To m
If arrK(cnt, 2) Like "*payment was made" Then
If arrK(cnt, 1) = "main store" Then
strMain = strMain & " " & cnt
Else
strAnother = strAnother & " " & cnt
End If
End If
Next cnt
'Output Main Store
clms = Array(1, 4, 6, 13, 14)
strRws = Split(strMain)
ReDim Rws(1 To UBound(strRws) + 1, 1 To 1)
For cnt = 1 To UBound(strRws) + 1
Rws(cnt, 1) = strRws(cnt - 1)
Next cnt
arrOut = Application.Index(wS.Cells, Rws, clms)
wM.Activate
wM.Range("19:" & wM.Rows.Count).Clear
wM.Range("19:" & wM.Rows.Count).Delete
m = UBound(arrOut, 1)
With wM.Range("A18").Resize(UBound(arrOut, 1), UBound(arrOut, 2))
.Value = arrOut
.Sort Key1:=wM.Range("C18"), Header:=True
End With
For i = Application.Ceiling(m / 27, 1) To 1 Step -1
r = 19 + 27 * i
wM.Range("A" & r).EntireRow.Insert
wM.Range("B" & r).Value = "Deputy Director"
wM.Range("D" & r).Value = "General Director"
wM.HPageBreaks.Add wM.Range("A" & r + 1)
Next i
n = wM.Range("B" & wM.Rows.Count).End(xlUp).Row
With wM.Range("A18:E" & n)
.Font.Name = "Times New Roman"
.Font.Size = 13
.RowHeight = 17
.Borders.LineStyle = xlContinuous
End With
With wM.Range("B18:B" & n)
Set c = .Find(What:="Deputy Director", LookAt:=xlWhole)
If Not c Is Nothing Then
a = c.Address
Do
With c.Offset(0, -1).Resize(1, 5)
.Borders(xlEdgeLeft).LineStyle = xlLineStyleNone
.Borders(xlInsideVertical).LineStyle = xlLineStyleNone
.Borders(xlEdgeRight).LineStyle = xlLineStyleNone
End With
Set c = .FindNext(After:=c)
Loop Until c.Address = a
End If
End With
'Output Another Stores
clms = Array(1, 4, 6, 13, 14)
strRws = Split(strAnother)
ReDim Rws(1 To UBound(strRws, 1) + 1, 1 To 1)
For cnt = 1 To UBound(strRws, 1) + 1
Rws(cnt, 1) = strRws(cnt - 1)
Next cnt
arrOut = Application.Index(wS.Cells, Rws, clms)
wA.Activate
wA.Range("19:" & wM.Rows.Count).Clear
wA.Range("19:" & wM.Rows.Count).Delete
m = UBound(arrOut, 1)
With wA.Range("A18").Resize(m, UBound(arrOut, 2))
.Value = arrOut
.Sort Key1:=wA.Range("C18"), Header:=True
End With
For i = Application.Ceiling(m / 27, 1) To 1 Step -1
r = 19 + 27 * i
wA.Range("A" & r).EntireRow.Insert
wA.Range("B" & r).Value = "Deputy Director"
wA.Range("D" & r).Value = "General Director"
wA.HPageBreaks.Add wA.Range("A" & r + 1)
Next i
n = wA.Range("B" & wA.Rows.Count).End(xlUp).Row
With wA.Range("A18:E" & n)
.Font.Name = "Times New Roman"
.Font.Size = 13
.RowHeight = 17
.Borders.LineStyle = xlContinuous
End With
With wA.Range("B18:B" & n)
Set c = .Find(What:="Deputy Director", LookAt:=xlWhole)
If Not c Is Nothing Then
a = c.Address
Do
With c.Offset(0, -1).Resize(1, 5)
.Borders(xlEdgeLeft).LineStyle = xlLineStyleNone
.Borders(xlInsideVertical).LineStyle = xlLineStyleNone
.Borders(xlEdgeRight).LineStyle = xlLineStyleNone
End With
Set c = .FindNext(After:=c)
Loop Until c.Address = a
End If
End With
End Sub
Best wishes,
Hans
Hans
-
- 2StarLounger
- Posts: 182
- Joined: 24 Jan 2019, 10:58
Re: Filtering data depending on a specific column
Thanks a lot Mr. Hans for this great solution .. It works perfectly
Best Regards
Best Regards
-
- 2StarLounger
- Posts: 182
- Joined: 24 Jan 2019, 10:58
Re: Filtering data depending on a specific column
I am so sorry Mr. Hans for disturbing you again in this topic ..
With clear the Print Area of the Main Store and Another Stores sheets … The borders of the following pages appear below the signatures.
Is there any additional lines to set the print area Below these two lines of code.
Thanks again for all your help
With clear the Print Area of the Main Store and Another Stores sheets … The borders of the following pages appear below the signatures.
Is there any additional lines to set the print area Below these two lines of code.
Code: Select all
wM.HPageBreaks.Add wM.Range("A" & r + 1)
Code: Select all
wA.HPageBreaks.Add wA.Range("A" & r + 1)
You do not have the required permissions to view the files attached to this post.