Forum Discussion

gbavikati's avatar
gbavikati
Copper Contributor
Dec 19, 2024

VBA requirement

Hi everyone,

 

I’ve written a VBA script to dynamically retrieve and display data based on user interactions in an Excel workbook. The script triggers when I select a cell in Sheet1 (which contains product names) and performs the following tasks:

  1. Searches for the selected product in Sheet2, retrieves its category and price.
  2. Looks for matches in Sheet3 based on the category or price.
  3. Copies matching rows from Sheet3 into Sheet4, grouping results by category, and organizes them in separate column groups (e.g., Columns A-J for one category, K-T for the next, etc.).

 

Additionally, the script clears previous results in Sheet4 and displays a message if no matches are found.

What I Need Help With:

  1. Optimizing the script to handle larger datasets more efficiently.
  2. Suggestions for improving readability and maintainability of the code.
  3. Advice on handling edge cases or potential bugs I might have missed.
  4. Any recommendations to enhance the functionality or logic.

 

I’d really appreciate your feedback and suggestions! Let me know if you need more details about the logic or the structure of my workbook.

 

Thanks in advance! 😊

  • gbavikati's avatar
    gbavikati
    Copper Contributor

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)

        Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet

        Dim selectedValue As String

        Dim lastRowSheet2 As Long, lastRowSheet3 As Long, lastRowOutput As Long

        Dim i As Long, j As Long

        Dim category As String, price As Double

        Dim matchCount As Integer

        Dim outputColumn As Integer

        Dim previousCategory As String

        Dim rowOffset As Integer

        

        ' Set references to worksheets

        Set ws1 = ThisWorkbook.Sheets("Sheet1")

        Set ws2 = ThisWorkbook.Sheets("Sheet2")

        Set ws3 = ThisWorkbook.Sheets("Sheet3")

        Set ws4 = ThisWorkbook.Sheets("Sheet4")

        

        ' Exit if clicked cell is empty or not in the intended column

        If IsEmpty(Target.Value) Or Target.Column < 1 Then Exit Sub

        

        ' Fetch the value from the clicked cell (Product Name)

        selectedValue = Target.Value

        

        ' Clear content starting from row 3 in Sheet4 (keeping rows 1 and 2 intact)

        ws4.Rows("3:" & ws4.Rows.Count).ClearContents

        

        ' You can use row 2 for your own filter data if needed.

        ' Example: ws4.Rows(2).Value = ... (your custom data or filter criteria)

        

        ' Initialize output column to start from Column A

        outputColumn = 1

        rowOffset = 3 ' Start from row 3 after the header and filter rows

        previousCategory = ""

        

        ' First filter: Search in Sheet2 for matching Product

        lastRowSheet2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

        matchCount = 0

        

        For i = 2 To lastRowSheet2 ' Skip header row

            If ws2.Cells(i, 1).Value = selectedValue Then

                matchCount = matchCount + 1

                category = ws2.Cells(i, 2).Value

                price = ws2.Cells(i, 3).Value

                

                ' Second filter: Search in Sheet3 for matching Category OR Price in Column A

                lastRowSheet3 = ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row

                For j = 2 To lastRowSheet3 ' Skip header row

                    If ws3.Cells(j, 1).Value = category Or ws3.Cells(j, 1).Value = price Then

                        ' If we find a new category, shift the output to the next column (K-T, etc.)

                        If category <> previousCategory Then

                            ' Move to next set of columns after the previous category (K-T, etc.)

                            If previousCategory <> "" Then

                                outputColumn = outputColumn + 10 ' Shift to the next set of columns

                            End If

                            previousCategory = category ' Update to the current category

                            rowOffset = 3 ' Start from row 3 for the new category

                        End If

                        

                        ' Copy matched row data from Sheet3 to Sheet4

                        ws4.Cells(rowOffset, outputColumn).Resize(1, 10).Value = ws3.Cells(j, 1).Resize(1, 10).Value

                        rowOffset = rowOffset + 1 ' Move to the next row for the same category

                    End If

                Next j

            End If

        Next i

        

        ' If no matches found, display a message

        If ws4.Cells(ws4.Rows.Count, "A").End(xlUp).Row = 2 Then

            MsgBox "No matches found in Sheet3 for the selected product.", vbExclamation

        Else

            ' Redirect to Sheet4 to view the results

            ws4.Activate

        End If

    End Sub

     

    This what I am using

    • HansVogelaar's avatar
      HansVogelaar
      MVP

      The outer loop can be made more efficient by using the Find method of Range("A:A").

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
          Dim ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
          Dim selectedValue As String
          Dim lastRowSheet3 As Long
          Dim j As Long
          Dim category As String, price As Double
          Dim matchCount As Integer
          Dim outputColumn As Integer
          Dim previousCategory As String
          Dim rowOffset As Integer
          Dim foundSheet2 As Range
          Dim addressSheet2 As String
      
          Application.ScreenUpdating = False
      
          ' Set references to worksheets
          Set ws2 = ThisWorkbook.Sheets("Sheet2")
          Set ws3 = ThisWorkbook.Sheets("Sheet3")
          Set ws4 = ThisWorkbook.Sheets("Sheet4")
      
          ' Exit if multiple cells selected
          If Target.CountLarge > 1 Then Exit Sub
          ' Exit if clicked cell is empty or not in the intended column
          If IsEmpty(Target.Value) Or Target.Column < 1 Then Exit Sub
      
          ' Fetch the value from the clicked cell (Product Name)
          selectedValue = Target.Value
      
          ' Clear content starting from row 3 in Sheet4 (keeping rows 1 and 2 intact)
          ws4.Rows("3:" & ws4.Rows.Count).ClearContents
      
          ' You can use row 2 for your own filter data if needed.
          ' Example: ws4.Rows(2).Value = ... (your custom data or filter criteria)
          
          ' Initialize output column to start from Column A
          outputColumn = 1
          rowOffset = 3 ' Start from row 3 after the header and filter rows
          previousCategory = ""
      
          ' First filter: Search in Sheet2 for matching Product
          matchCount = 0
      
          Set foundSheet2 = ws2.Range("A:A").Find(What:=selectedValue, LookAt:=xlWhole)
          If Not foundSheet2 Is Nothing Then
              addressSheet2 = foundSheet2.Address
              Do
                  matchCount = matchCount + 1
                  category = foundSheet2.Offset(0, 1).Value
                  price = foundSheet2.Offset(0, 2).Value
                  ' Second filter: Search in Sheet3 for matching Category OR Price in Column A
                  lastRowSheet3 = ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row
                  For j = 2 To lastRowSheet3 ' Skip header row
                      If ws3.Cells(j, 1).Value = category Or ws3.Cells(j, 1).Value = price Then
                          ' If we find a new category, shift the output to the next column (K-T, etc.)
                          If category <> previousCategory Then
                              ' Move to next set of columns after the previous category (K-T, etc.)
                              If previousCategory <> "" Then
                                  outputColumn = outputColumn + 10 ' Shift to the next set of columns
                              End If
                              previousCategory = category ' Update to the current category
                              rowOffset = 3 ' Start from row 3 for the new category
                          End If
      
                          ' Copy matched row data from Sheet3 to Sheet4
                          ws4.Cells(rowOffset, outputColumn).Resize(1, 10).Value = ws3.Cells(j, 1).Resize(1, 10).Value
                          rowOffset = rowOffset + 1 ' Move to the next row for the same category
                      End If
                  Next j
                  Set foundSheet2 = ws2.Range("A:A").Find(What:=selectedValue, After:=foundSheet2, LookAt:=xlWhole)
                  If foundSheet2 Is Nothing Then Exit Do
              Loop Until foundSheet2.Address = addressSheet2
          End If
      
          ' If no matches found, display a message
          If ws4.Cells(ws4.Rows.Count, "A").End(xlUp).Row = 2 Then
              MsgBox "No matches found in Sheet3 for the selected product.", vbExclamation
          Else
              ' Redirect to Sheet4 to view the results
              ws4.Activate
          End If
      
          Application.ScreenUpdating = True
      End Sub

       

  • gbavikati's avatar
    gbavikati
    Copper Contributor

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)

        Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet

        Dim selectedValue As String

        Dim lastRowSheet2 As Long, lastRowSheet3 As Long, lastRowOutput As Long

        Dim i As Long, j As Long

        Dim category As String, price As Double

        Dim matchCount As Integer

        Dim outputColumn As Integer

        Dim previousCategory As String

        Dim rowOffset As Integer

        

        ' Set references to worksheets

        Set ws1 = ThisWorkbook.Sheets("Sheet1")

        Set ws2 = ThisWorkbook.Sheets("Sheet2")

        Set ws3 = ThisWorkbook.Sheets("Sheet3")

        Set ws4 = ThisWorkbook.Sheets("Sheet4")

        

        ' Exit if clicked cell is empty or not in the intended column

        If IsEmpty(Target.Value) Or Target.Column < 1 Then Exit Sub

        

        ' Fetch the value from the clicked cell (Product Name)

        selectedValue = Target.Value

        

        ' Clear content starting from row 3 in Sheet4 (keeping rows 1 and 2 intact)

        ws4.Rows("3:" & ws4.Rows.Count).ClearContents

        

        ' You can use row 2 for your own filter data if needed.

        ' Example: ws4.Rows(2).Value = ... (your custom data or filter criteria)

        

        ' Initialize output column to start from Column A

        outputColumn = 1

        rowOffset = 3 ' Start from row 3 after the header and filter rows

        previousCategory = ""

        

        ' First filter: Search in Sheet2 for matching Product

        lastRowSheet2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

        matchCount = 0

        

        For i = 2 To lastRowSheet2 ' Skip header row

            If ws2.Cells(i, 1).Value = selectedValue Then

                matchCount = matchCount + 1

                category = ws2.Cells(i, 2).Value

                price = ws2.Cells(i, 3).Value

                

                ' Second filter: Search in Sheet3 for matching Category OR Price in Column A

                lastRowSheet3 = ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row

                For j = 2 To lastRowSheet3 ' Skip header row

                    If ws3.Cells(j, 1).Value = category Or ws3.Cells(j, 1).Value = price Then

                        ' If we find a new category, shift the output to the next column (K-T, etc.)

                        If category <> previousCategory Then

                            ' Move to next set of columns after the previous category (K-T, etc.)

                            If previousCategory <> "" Then

                                outputColumn = outputColumn + 10 ' Shift to the next set of columns

                            End If

                            previousCategory = category ' Update to the current category

                            rowOffset = 3 ' Start from row 3 for the new category

                        End If

                        

                        ' Copy matched row data from Sheet3 to Sheet4

                        ws4.Cells(rowOffset, outputColumn).Resize(1, 10).Value = ws3.Cells(j, 1).Resize(1, 10).Value

                        rowOffset = rowOffset + 1 ' Move to the next row for the same category

                    End If

                Next j

            End If

        Next i

        

        ' If no matches found, display a message

        If ws4.Cells(ws4.Rows.Count, "A").End(xlUp).Row = 2 Then

            MsgBox "No matches found in Sheet3 for the selected product.", vbExclamation

        Else

            ' Redirect to Sheet4 to view the results

            ws4.Activate

        End If

    End Sub

Resources