Forum Discussion

yvsriravi12047's avatar
yvsriravi12047
Copper Contributor
Jun 15, 2023

Need VBA Code

 

This is very urgent requirement,  please some one kindly help me on this.

  • NikolinoDE's avatar
    NikolinoDE
    Gold Contributor

    yvsriravi12047 

    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

    • yvsriravi12047's avatar
      yvsriravi12047
      Copper 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)

      • NikolinoDE's avatar
        NikolinoDE
        Gold Contributor

        yvsriravi12047 

        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!

Resources