Excel Forum

Code: Select all

Sub MotherLotSelected()
Dim lngLastRow As Long
 
    Worksheets("Sampled").Select
    Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    
    If DoesWorkSheetExist("Mother_Lot_Sampled") = False Then  'If "Temp" sheet not there, create it.
        Worksheets.Add().Name = "Mother_Lot_Sampled"
    End If
    Worksheets("Mother_Lot_Sampled").Select
    ActiveSheet.Tab.ColorIndex = xlColorIndexNone               ' Remove tab color
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "MOTHERLOT"
    
    Range("B2").Select
    ActiveCell.Formula = "=LEFT(A2,13)"
    
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    'Range("B2").AutoFill Destination:=Range("B2:B" & lngLastRow)
    
    ActiveSheet.Move After:=ActiveWorkbook.Sheets("Load")

End Sub


Sub GroupAssignment()
Dim lngLastRow As Long
Dim lngLastRowSource As Long
Dim strLastRowSource As String
Dim strFormulaText As String


    Worksheets("Load").Select
    Range("H1").Select
    ActiveCell.Formula = "MOTHERLOT"
    
    Range("H2").Select
    ActiveCell.Formula = "=LEFT(B2,13)"
    
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Range("H2").AutoFill Destination:=Range("H2:H" & lngLastRow)
    
    Worksheets("Mother_Lot_Sampled").Select
    
    lngLastRowSource = Sheets("Mother_Lot_Sampled").Cells(Rows.Count, "A").End(xlUp).Row
    
    Worksheets("Load").Select
    
    Range("H1:H" & lngLastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("Mother_Lot_Sampled").Range("B1:B" & lngLastRowSource), Unique:=False
        
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.ShowAllData

   
         
    Range("C1").Select
    ActiveCell.Formula = "AA"
    
    Range("D1").Select
    ActiveCell.Formula = "BB"
    
    Range("E1").Select
    ActiveCell.Formula = "CC"
    
    Range("F1").Select
    ActiveCell.Formula = "DD"
    
    Range("G1").Select
    ActiveCell.Formula = "EE"
    
      
    
     Sheets("Data").Select
    lngLastRowSource = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row                   ' Get the last Target
    strLastRowSource = "$B$2:$N$" & CStr(lngLastRowSource)
    
    Worksheets("Load").Select
    
    Range("C2").Select
    ActiveCell.Formula = _
    "=IF(ISNA(VLOOKUP(A2,'Data'!" + strLastRowSource + ",2,FALSE)),""N/A"",VLOOKUP(A2,'Data'!" + strLastRowSource + ",2,FALSE))"

    Range("D2").Select
    ActiveCell.Formula = _
    "=IF(ISNA(VLOOKUP(A2,'Data'!" + strLastRowSource + ",3,FALSE)),""N/A"",VLOOKUP(A2,'Data'!" + strLastRowSource + ",3,FALSE))"
        
    Range("E2").Select
    ActiveCell.Formula = _
    "=IF(ISNA(VLOOKUP(A2,'Data'!" + strLastRowSource + ",4,FALSE)),""N/A"",VLOOKUP(A2,'Data'!" + strLastRowSource + ",4,FALSE))"
    
    Range("F2").Select
    ActiveCell.Formula = _
    "=IF(ISNA(VLOOKUP(A2,'Data'!" + strLastRowSource + ",5,FALSE)),""N/A"",VLOOKUP(A2,'Data'!" + strLastRowSource + ",5,FALSE))"

    Range("G2").Select
    ActiveCell.Formula = _
    "=IF(ISNA(VLOOKUP(A2,'Data'!" + strLastRowSource + ",6,FALSE)),""N/A"",VLOOKUP(A2,'Data'!" + strLastRowSource + ",6,FALSE))"

Range("C2:G2").Select
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Selection.AutoFill Destination:=Range("C2:G" & lngLastRow)
End Sub




Public Function DoesWorkSheetExist(WorkSheetName As String, Optional WorkBookName As String)
Dim WS As Worksheet
     
    On Error Resume Next
    If WorkBookName = vbNullString Then
        Set WS = Sheets(WorkSheetName)
    Else
        Set WS = Workbooks(WorkBookName).Sheets(WorkSheetName)
    End If
    On Error GoTo 0
     
    DoesWorkSheetExist = Not WS Is Nothing

End Function



Sub Main()
Const strHandledSheet As String = "Load"

On Error GoTo ErrorHandling
Worksheets(strHandledSheet).Select

    Application.ScreenUpdating = False
    
    
    MotherLotSelected
    GroupAssignment

Exit Sub

ErrorHandling:
    MsgBox ("No >> ") & strHandledSheet & ("<< sheet available")
    
End Sub

Code: Select all

Range("C2").Select
    ActiveCell.Formula = _
    "=IF(ISNA(VLOOKUP(A2,'Data'!" + strLastRowSource + ",[color=#FF0000]2[/color],FALSE)),""N/A"",VLOOKUP(A2,'Data'!" + strLastRowSource + ",[color=#FF0000]2[/color],FALSE))"

Code: Select all

Sub Test0()
    Dim rs As Range, rtAll As Range, rt As Range
    Dim s As Worksheet
    
    Set s = Worksheets.Add
    
    With Sheets("Data")
       Set rtAll = .Range("b2", .Range("b" & .Rows.Count).End(xlUp))
       .Range("a1:g1").Copy s.Range("a1")
    End With
    With Sheets("Load")
        For Each rs In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
            For Each rt In rtAll
                If rt.Value = rs.Value Then
                    s.Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                        .Resize(1, 7).Value = rt.Resize(1, 7).Value
                End If
            Next rt
        Next rs
    End With
End Sub