PDA

View Full Version : [SLEEPER:] VBA Figure out how to perform two different import actions into the same sheet



fabioc99
04-23-2025, 01:21 AM
Good morning everyone! I just signed up. My name is Fabio.
I'm having an issue with the file I'm sharing here. I use both VBA and Excel data features.
I want to create a new sheet called 'RCF TT+ QUOTATION'. This sheet already exists in the file.
There’s also a sheet named '2025' that contains the source data.
In the 'RCF TT+' sheet, from cells E2 to E10, I have dropdowns that pull data from cells E2 to E15 of the '2025' sheet. When one of these is selected, I want it to automatically import not just column E, but also columns A, B, C, D, F, G, H, I, J, K, P, Q, R, and S. Columns L, M, N, and O are hidden and not needed for me.
In the 'RACK' sheet, I’ve set up dropdowns that pull only from column E of the '2025' sheet. The dropdowns are in the ranges C4:H150 and J4:P150. I use formulas in that sheet to do calculations.
Now, here’s what I’d like to do using VBA on the 'RCF TT+ QUOTATION' sheet:
I want it so that when I select cells like E1, E2, E3 (and so on) on the 'RCF TT+' sheet, the data is automatically copied to the 'RCF TT+ QUOTATION' sheet.
Also, if I remove an entry (clear a dropdown) on 'RCF TT+', it should also be removed from the 'RCF TT+ QUOTATION' sheet.
In the 'RACK' sheet, when I select a value from a dropdown (taken from column E of '2025'), I want the corresponding data from columns A, B, C, D, F, G, H, I, J, and K to be shown in 'RCF TT+ QUOTATION'.
In column P of that sheet, I’d like to show the number of the matching cell with that value.
For example, if I select "E5" in cell B5 and also in D10 on the 'RACK' sheet, the values should appear and be summed up on the 'RCF TT+ QUOTATION' sheet.
Basically, the 'RCF TT+' sheet already does the math and I assign the numbers manually there, but in the 'RACK' sheet I want all of this to be done automatically.
Another issue: I can’t seem to get the VBA code to work when I select multiple rows at once in the 'RCF TT+' sheet — like E2 and E3 — to show up automatically on 'RCF TT+ QUOTATION'.
If I delete those and then go back to 'RACK', selecting multiple cells doesn’t properly update 'RCF TT+ QUOTATION' as expected.
I’m not sure why this is happening.
Sorry if my explanation wasn’t super clear!
I just wanted to ask if it’s possible to do these two things within the file I’m sharing.
Thanks again for your kindness!

p45cal
04-23-2025, 01:56 AM
I just wanted to ask if it’s possible to do these two things within the file I’m sharing.No file.

fabioc99
04-23-2025, 02:20 AM
I'm sorry! Please, how can I import the ".xlsx" file? I'm unable to see the import on my PC, could you help me, please? Thanks! : )

Aussiebear
04-23-2025, 02:33 AM
Hmm.... Until the experts turn up,would this be something helpful


Private Sub Worksheet_Change(ByVal Target As Range)
' Define the source and destination sheets
Dim wsSourceRCF As Worksheet
Dim wsSourceRack As Worksheet
Dim wsQuotation As Worksheet
Set wsSourceRCF = ThisWorkbook.Sheets("RCF TT+")
Set wsSourceRack = ThisWorkbook.Sheets("RACK")
Set wsQuotation = ThisWorkbook.Sheets("RCF TT+ QUOTATION")
' Handling changes in 'RCF TT+' sheet
If Not Intersect(Target, wsSourceRCF.Range("E2:E10")) Is Nothing Then
Application.EnableEvents = False. ' Disable events to prevent infinite loops
Dim cell As Range
For Each cell In Intersect(Target, wsSourceRCF.Range("E2:E10"))
Dim quotationRow As Long
' Check if the selected value already exists in 'RCF TT+ QUOTATION'
On Error Resume Next
quotationRow = Application.Match(cell.Value, wsQuotation.Range("E:E"), 0)
On Error GoTo 0
If Not IsEmpty(cell.Value) Then
' If the value is selected in 'RCF TT+', and doesn't exist in quotation, add it
If quotationRow = 0 Then
Dim lastRowQuotation As Long
lastRowQuotation = wsQuotation.Cells(Rows.Count, "A").End(xlUp).Row + 1
' Copy the entire row from '2025' based on the dropdown value
Dim foundRow As Range
Set foundRow = ThisWorkbook.Sheets("2025").Range("E:E").Find(cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not foundRow Is Nothing Then
wsQuotation.Cells(lastRowQuotation, "A").Resize(1, 15).Value = wsSource.Cells(foundRow.Row, "A").Resize(1, 15).Value
wsQuotation.Cells(lastRowQuotation, "P").Resize(1, 4).Value = wsSource.Cells(foundRow.Row, "P").Resize(1, 4).Value
End If
End If
Else
' If the dropdown is cleared in 'RCF TT+', remove the corresponding row in quotation
If quotationRow > 0 Then
wsQuotation.Rows(quotationRow).Delete
End If
End If
Next cell
Application.EnableEvents = True. ' Re-enable events
End If
' Handling changes in 'RACK' sheet
If Not Intersect(Target, Union(wsSourceRack.Range("C4:H150"), wsSourceRack.Range("J4:P150"))) Is Nothing Then
Application.EnableEvents = False
' Disable events
Dim cellRack As Range
For Each cellRack In Intersect(Target, Union(wsSourceRack.Range("C4:H150"), wsSourceRack.Range("J4:P150")))
If Not IsEmpty(cellRack.Value) Then
' Find the corresponding row in '2025'
Dim foundRowRack As Range
Set foundRowRack = ThisWorkbook.Sheets("2025").Range("E:E").Find(cellRack.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not foundRowRack Is Nothing Then
' Check if this item from 'RACK' is already in the quotation
Dim quotationRackRow As Long
On Error Resume Next
quotationRackRow = Application.Match(foundRowRack.Value, wsQuotation.Range("E:E"), 0)
On Error GoTo 0
If quotationRackRow = 0 Then
' Add a new row if it doesn't exist
Dim lastRowQuotation As Long
lastRowQuotation = wsQuotation.Cells(Rows.Count, "A").End(xlUp).Row + 1
wsQuotation.Cells(lastRowQuotation, "A").Resize(1, 4).Value = ThisWorkbook.Sheets("2025").Cells(foundRowRack.Row, "A").Resize(1, 4).Value
wsQuotation.Cells(lastRowQuotation, "E").Value = foundRowRack.Value
wsQuotation.Cells(lastRowQuotation, "F").Resize(1, 6).Value = ThisWorkbook.Sheets("2025").Cells(foundRowRack.Row, "F").Resize(1, 6).Value
wsQuotation.Cells(lastRowQuotation, "K").Value = ThisWorkbook.Sheets("2025").Cells(foundRowRack.Row, "K").Value
wsQuotation.Cells(lastRowQuotation, "P").Resize(1, 4).Value = ThisWorkbook.Sheets("2025").Cells(foundRowRack.Row, "P").Resize(1, 4).Value
Else
' If it exists, maybe you want to update something?
For now, we'll leave it as is.
' You can add logic here if you need to update quantities or other details.
End If
' Update the count in column P
Dim countRange As Range
Set countRange = wsQuotation.Range("E:E")
Dim matchCount As Long
matchCount = Application.WorksheetFunction.CountIf(countRange, foundRowRack.Value)
' Find the first occurrence of this value in 'RCF TT+ QUOTATION' and update column P
Dim firstMatch As Range
Set firstMatch = countRange.Find(foundRowRack.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not firstMatch Is Nothing Then
wsQuotation.Cells(firstMatch.Row, "P").Value = matchCount
End If
End If
Else
' If a value is cleared in 'RACK', you might want to remove it from quotation
' This requires careful consideration of how to identify the correct row to delete as multiple 'RACK' cells could refer to the same item.
' A more robust solution might involve a unique identifier.
' For now, we'll skip automatic deletion based on clearing
'RACK' cells.
End If
Next cellRack
Application.EnableEvents = True
' Re-enable events
End If
End Sub

fabioc99
04-23-2025, 02:58 AM
Thank you very much, I imported the file you sent me, however, I'm getting this error: 'Compile error: Syntax error'. It highlights the line: .Find(cell.Value, LookIn:=xlValues, LookAt:=xlWhole). Could you please help me? Can I add the .xlsm in this message, and you can download it?Thanks again for your reply!

georgiboy
04-23-2025, 02:59 AM
See if the link in my signature can help you upload the file.

fabioc99
04-23-2025, 03:06 AM
Thank you so much! I uploaded the file! :)

Aussiebear
04-23-2025, 03:30 AM
Righto, for all the Americans looking a this thread Yep that Strike 1, but for the rest of us mere mortals a mere swing and a miss. Try the code in Post # 4 again please

fabioc99
04-23-2025, 03:51 AM
I'll import the code, is it ok for you? Thank yu for your help! : )