Forum Discussion
gbavikati
Dec 19, 2024Copper Contributor
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:
- Searches for the selected product in Sheet2, retrieves its category and price.
- Looks for matches in Sheet3 based on the category or price.
- 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:
- Optimizing the script to handle larger datasets more efficiently.
- Suggestions for improving readability and maintainability of the code.
- Advice on handling edge cases or potential bugs I might have missed.
- 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! 😊
- gbavikatiCopper 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
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
- gbavikatiCopper 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
Did you intend to attach a sample workbook, or post a link to such a workbook?