[Solved] V-lookup parts of a range to other sheets

AVH

New member
dear friends,
i need a help for my macro, i have data and need to lookup to other data, the problem is, i need to separate the data into small range and lookup the data into several table, how to do that using macro, any kind of help i really appreciate it, thank you.

regards,
AVH
 

Attachments

dear friends,
i need a help for my macro, i have data and need to lookup to other data, the problem is, i need to separate the data into small range and lookup the data into several table, how to do that using macro, any kind of help i really appreciate it, thank you.

regards,
AVH
Dear AVH

Welcome to ExcelDemy Forum. Thanks for reaching out and sharing your problem.

I am delighted to inform you that I have developed an Excel VBA Sub-Procedure that will achieve your goal.

Follow these steps:
  1. Press Alt + F11 to open the VBE.
  2. Click on Insert followed by Module.
  3. Paste the following code in the module and Run it:
    Code:
    Sub MoveDataBasedCriteria()
        
        Dim wsPI As Worksheet
        Dim wsREM As Worksheet
        Dim wsTIRE As Worksheet
        Dim wsBAJA As Worksheet
        Dim wsCBU As Worksheet
        
        Set wsPI = ThisWorkbook.Sheets("PIVOT")
        Set wsREM = ThisWorkbook.Sheets("REM")
        Set wsTIRE = ThisWorkbook.Sheets("TIRE")
        Set wsBAJA = ThisWorkbook.Sheets("BAJA")
        Set wsCBU = ThisWorkbook.Sheets("CBU")
        
        Dim lastRow As Long
        Dim tempLastRow As Long
        Dim lastCol As Long
        Dim currentCol As Long
        Dim i, j, k As Long
        
        lastRow = wsPI.Cells(wsPI.Rows.Count, "C").End(xlUp).Row
        
        Dim piNo As String
        Dim invoiceNo As String
        Dim seriNo As String
        Dim sumPIB As Double
        
        For i = 2 To lastRow
            
            If wsPI.Range("A" & i).Value <> "" Then
                piNo = wsPI.Range("A" & i).Value
            End If
            
            If wsPI.Range("B" & i).Value <> "" Then
                invoiceNo = wsPI.Range("B" & i).Value
            End If
            
            seriNo = wsPI.Range("C" & i).Value
            sumPIB = wsPI.Range("D" & i).Value
            
            If piNo = "04.PI-05.24.0254" Then
                
                lastCol = wsBAJA.Cells(2, wsBAJA.Columns.Count).End(xlToLeft).Column
                tempLastRow = wsBAJA.Cells(wsBAJA.Rows.Count, "B").End(xlUp).Row
                
                
                If lastCol > 4 Then
                    
                    For k = 5 To lastCol
                        If wsBAJA.Cells(2, k).Value = invoiceNo Then
                            currentCol = k
                            Exit For
                        Else
                            currentCol = k + 1
                        End If
                
                    Next k
                    
                    wsBAJA.Cells(2, currentCol).Value = invoiceNo
                
                Else
                    wsBAJA.Cells(2, lastCol + 1).Value = invoiceNo
                    currentCol = lastCol + 1
                End If
                
                For j = 3 To tempLastRow
                    
                    If wsBAJA.Cells(j, 2).Value = seriNo Then
                        wsBAJA.Cells(j, currentCol).Value = sumPIB
                        Exit For
                    End If
                    
                Next j
                
            ElseIf piNo = "04.PI-66.23.0071" Then
                lastCol = wsTIRE.Cells(2, wsTIRE.Columns.Count).End(xlToLeft).Column
                tempLastRow = wsTIRE.Cells(wsTIRE.Rows.Count, "B").End(xlUp).Row
                
                
                If lastCol > 4 Then
                    
                    For k = 5 To lastCol
                        If wsTIRE.Cells(2, k).Value = invoiceNo Then
                            currentCol = k
                            Exit For
                        Else
                            currentCol = k + 1
                        End If
                
                    Next k
                    
                    wsTIRE.Cells(2, currentCol).Value = invoiceNo
                
                Else
                    wsTIRE.Cells(2, lastCol + 1).Value = invoiceNo
                    currentCol = lastCol + 1
                End If
                
                For j = 3 To tempLastRow
                    
                    If wsTIRE.Cells(j, 2).Value = seriNo Then
                        wsTIRE.Cells(j, currentCol).Value = sumPIB
                        Exit For
                    End If
                    
                Next j
                
            ElseIf piNo = "04.SK-33.24.0027" Then
                lastCol = wsREM.Cells(2, wsREM.Columns.Count).End(xlToLeft).Column
                tempLastRow = wsREM.Cells(wsREM.Rows.Count, "B").End(xlUp).Row
                
                
                If lastCol > 4 Then
                    
                    For k = 5 To lastCol
                        If wsREM.Cells(2, k).Value = invoiceNo Then
                            currentCol = k
                            Exit For
                        Else
                            currentCol = k + 1
                        End If
                
                    Next k
                    
                    wsREM.Cells(2, currentCol).Value = invoiceNo
                
                Else
                    wsREM.Cells(2, lastCol + 1).Value = invoiceNo
                    currentCol = lastCol + 1
                End If
                
                For j = 3 To tempLastRow
                    
                    If wsREM.Cells(j, 2).Value = seriNo Then
                        wsREM.Cells(j, currentCol).Value = sumPIB
                        Exit For
                    End If
                    
                Next j
                
            ElseIf piNo = "04.SK-31.24.0040" Then
            
                lastCol = wsCBU.Cells(2, wsCBU.Columns.Count).End(xlToLeft).Column
                
                tempLastRow = wsCBU.Cells(wsCBU.Rows.Count, "B").End(xlUp).Row
                
                
                If lastCol > 4 Then
                    
                    For k = 5 To lastCol
                        If wsCBU.Cells(2, k).Value = invoiceNo Then
                            currentCol = k
                            Exit For
                        Else
                            currentCol = k + 1
                        End If
                
                    Next k
                    
                    wsCBU.Cells(2, currentCol).Value = invoiceNo
                
                Else
                    wsCBU.Cells(2, lastCol + 1).Value = invoiceNo
                    currentCol = lastCol + 1
                End If
                
                For j = 3 To tempLastRow
                    
                    If wsCBU.Cells(j, 2).Value = seriNo Then
                        wsCBU.Cells(j, currentCol).Value = sumPIB
                        Exit For
                    End If
                    
                Next j
                
            End If
            
        Next i
        
    End Sub
    Paste the given code in the module and Run to move data based on the particular criteria.png

As a result, you will get the desired output, such as the following GIF.

Output for moving data to other table sheet based on criteria using Excel VBA.gif

I have attached the solution workbook for better understanding; good luck.

Regards
Lutfor Rahman Shimanto
Excel & VBA Developer
ExcelDemy
 

Attachments

Online statistics

Members online
0
Guests online
10
Total visitors
10

Forum statistics

Threads
381
Messages
1,672
Members
721
Latest member
Dzaki wafi
Back
Top