Forum Discussion
yvsriravi12047
Jun 15, 2023Copper Contributor
Need VBA Code
This is very urgent requirement, please some one kindly help me on this.
- NikolinoDEGold Contributor
If I may recommend, paste the code as text. as a picture you can't really see the blanks... and why does someone who wants to help have to rewrite the existing code to test it?
At the same time I recommend you to add some more information. Information such as Excel version, operating system, storage medium. A precise description of the issue/problem, preferably a step-by-step description and possible messages, would also help "you".Thank you for your patience and understanding
- yvsriravi12047Copper Contributor
Sure, Excel office 365, Windows 11 Laptop
Here is the formula i have used in excel:
=SORT(UNIQUE(IF($A$3="",(VSTACK(UNIQUE(FILTER('Sheet 1'!D:D,('Sheet 1'!D:D<>"Batch No")*('Sheet 1'!D:D<>""))),UNIQUE(FILTER('Sheet 2'!D:D,('Sheet 2'!D:D<>"Batch No")*('Sheet 2'!D:D<>""))),UNIQUE(FILTER('Sheet 3'!D:D,('Sheet 3'!D:D<>"Batch No")*('Sheet 3'!D:D<>""))),UNIQUE(FILTER('Sheet 4'!D:D,('Sheet 4'!D:D<>"Batch No")*('Sheet 4'!D:D<>""))))),
(VSTACK(UNIQUE(FILTER('Sheet 1'!D:D,('Sheet 1'!A:A=$A$3)*('Sheet 1'!D:D<>"Batch No")*('Sheet 1'!D:D<>""))),UNIQUE(FILTER('Sheet 2'!D:D,('Sheet 2'!A:A=$A$3)*('Sheet 2'!D:D<>"Batch No")*('Sheet 2'!D:D<>""))),UNIQUE(FILTER('Sheet 3'!D:D,('Sheet 3'!A:A=$A$3)*('Sheet 3'!D:D<>"Batch No")*('Sheet 3'!D:D<>""))),UNIQUE(FILTER('Sheet 4'!D:D,('Sheet 4'!A:A=$A$3)*('Sheet 4'!D:D<>"Batch No")*('Sheet 4'!D:D<>""))))))),1)- NikolinoDEGold Contributor
Sub GetUniqueValues() Dim ws6 As Worksheet Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range Dim filterValue As Variant Dim result As Variant Dim i As Long, j As Long ' Set the worksheet references Set ws6 = ThisWorkbook.Worksheets("Sheet6") Set ws1 = ThisWorkbook.Worksheets("Sheet1") Set ws2 = ThisWorkbook.Worksheets("Sheet2") Set ws3 = ThisWorkbook.Worksheets("Sheet3") Set ws4 = ThisWorkbook.Worksheets("Sheet4") ' Get the filter value from Sheet6 B3 filterValue = ws6.Range("B3").Value ' Set the ranges based on the filter value If filterValue <> "" Then Set rng1 = ws1.Range("A:D").SpecialCells(xlCellTypeConstants) Set rng2 = ws2.Range("A:D").SpecialCells(xlCellTypeConstants) Set rng3 = ws3.Range("A:D").SpecialCells(xlCellTypeConstants) Set rng4 = ws4.Range("A:D").SpecialCells(xlCellTypeConstants) Else Set rng1 = ws1.Range("D:D").SpecialCells(xlCellTypeConstants) Set rng2 = ws2.Range("D:D").SpecialCells(xlCellTypeConstants) Set rng3 = ws3.Range("D:D").SpecialCells(xlCellTypeConstants) Set rng4 = ws4.Range("D:D").SpecialCells(xlCellTypeConstants) End If ' Combine the ranges and get unique values result = Application.WorksheetFunction.Unique(Application.WorksheetFunction.VStack(rng1, rng2, rng3, rng4)) ' Sort the unique values result = Application.WorksheetFunction.Sort(result, 1) ' Clear existing data in Sheet6 column A ws6.Range("A:A").ClearContents ' Write the unique values to Sheet6 column A For i = 1 To UBound(result, 1) ws6.Cells(i, 1).Value = result(i, 1) Next i End Sub
This code should work (untested) as long as you have Excel 365 or a version of Excel that supports dynamic arrays and the VStack and Unique functions. If you have an older version of Excel, you may need to use a different approach.
I hope it helps!