Consulting

Results 1 to 9 of 9

Thread: VBA Figure out how to perform two different import actions into the same sheet

  1. #1

    VBA Figure out how to perform two different import actions into the same sheet

    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!

  2. #2
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,959
    Quote Originally Posted by fabioc99 View Post
    I just wanted to ask if it’s possible to do these two things within the file I’m sharing.
    No file.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    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! : )

  4. #4
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,395
    Location
    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 
        End If
        ' 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
    Last edited by Aussiebear; 04-23-2025 at 12:46 PM. Reason: Code layout getting scrambled when posting
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  5. #5
    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!

  6. #6
    Administrator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,278
    Location
    See if the link in my signature can help you upload the file.
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2408, Build 17928.20080

  7. #7
    Thank you so much! I uploaded the file!
    Attached Files Attached Files

  8. #8
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,395
    Location
    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
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  9. #9
    I'll import the code, is it ok for you? Thank yu for your help! : )
    Last edited by fabioc99; 04-23-2025 at 04:06 AM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •