Posts by jaslake

Option Explicit
Private Sub CommandButton6_Click()
   Dim rng          As Range
   Dim Cel1         As Range
   Dim LR           As Long
   Dim ws           As Worksheet
   Set ws = Sheets("Sheet1")
   With ws
      LR = .Cells(.Rows.Count, "A").End(xlUp).Row
      Set rng = .Range("A1:A" & LR).SpecialCells(xlCellTypeVisible)
      With Me.ListBox1
         .ColumnCount = 7  '<---Should be 8 if you're including Column H
         For Each Cel1 In rng
            .AddItem CStr(Cel1.Value)
            .List(.ListCount - 1, 1) = Cel1.Offset(0, 1).Value
            .List(.ListCount - 1, 2) = Cel1.Offset(0, 2).Value
            .List(.ListCount - 1, 3) = Cel1.Offset(0, 3).Value
            .List(.ListCount - 1, 4) = Cel1.Offset(0, 4).Value
            .List(.ListCount - 1, 5) = Cel1.Offset(0, 5).Value
            .List(.ListCount - 1, 6) = Cel1.Offset(0, 6).Value
            .List(.ListCount - 1, 7) = Cel1.Offset(0, 7).Value
         Next Cel1
      End With
   End With
End Sub

Set Rng = .Range("A1:A" & LR).SpecialCells(xlCellTypeVisible)
        With ListBox1
            .ColumnCount = 10
            For Each Cel1 In Rng
                .AddItem CStr(Cel1.Value)
                .List(.ListCount - 1, 1) = Cel1.Offset(0, 1).Value
                .List(.ListCount - 1, 2) = Cel1.Offset(0, 2).Value
                .List(.ListCount - 1, 3) = Cel1.Offset(0, 3).Value
                .List(.ListCount - 1, 4) = Cel1.Offset(0, 4).Value
                .List(.ListCount - 1, 5) = Cel1.Offset(0, 5).Value
                .List(.ListCount - 1, 6) = Cel1.Offset(0, 6).Value
                .List(.ListCount - 1, 7) = Cel1.Offset(0, 7).Value
                .List(.ListCount - 1, 8) = Cel1.Offset(0, 8).Value
                .List(.ListCount - 1, 9) = Cel1.Offset(0, 9).Value
            Next Cel1
        End With

Option Explicit
Sub test()
   Dim ws1          As Worksheet
   Dim ws2          As Worksheet
   Dim ws3          As Worksheet
   Dim Rng2         As Range
   Dim Rng3         As Range
   Dim cel2         As Range
   Dim cel3         As Range
   Dim LR2          As Long
   Dim x            As Long
   Dim i            As Long
   Dim j            As Long
   Dim myQty        As String
   Dim Cnt          As Long
   Set ws1 = Sheet1
   Set ws2 = Sheet2
   Application.ScreenUpdating = False
   If Not Evaluate("ISREF(Output!A1)") Then
      Worksheets.Add(After:=Sheet2).Name = "Output"
   Else
      Sheets("Output").Cells.Clear
   End If
   Set ws3 = Sheets("Output")
   ws1.Cells.Copy ws3.Range("A1")
   Cnt = 1
   With ws2
      If Not .AutoFilterMode Then
         .Rows("1:1").AutoFilter
      End If
      .Columns("F:F").ClearContents
      .Range("F1").Value = "Grp"
      LR2 = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row
      Set Rng2 = .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
      .Range("F2").Value = Cnt
      
      For Each cel2 In Rng2
         If cel2.Value = cel2.Offset(1, 0).Value _
         And cel2.Offset(0, 1).Value = cel2.Offset(1, 1).Value Then
            .Cells(cel2.Row, "F").Offset(1, 0) = Cnt
         ElseIf Not cel2.Offset(1, 0).Value = "" Then
            Cnt = Cnt + 1
            .Cells(cel2.Row, "F").Offset(1, 0) = Cnt
         Else
         End If
      Next cel2
      
      ws2.Rows("1:1").AutoFilter
   End With
   myQty = ""
   With ws3
      .Cells(1, "G").Value = "Lot No.-Qty"
      .Cells(1, "H").Value = "Grp"
      i = .Range("C:C").Cells.SpecialCells(xlCellTypeConstants).Count - 1
      For j = 1 To i
         .Cells(j + 1, "H") = j
      Next j
      Set Rng3 = .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
      For Each cel3 In Rng3
         ws2.Range("A1:H" & LR2).AutoFilter Field:=2, Criteria1:=cel3.Value
         ws2.Range("A1:H" & LR2).AutoFilter Field:=3, Criteria1:=cel3.Offset(0, 1).Value
         ws2.Range("A1:H" & LR2).AutoFilter Field:=6, Criteria1:=cel3.Offset(0, 6).Value
         x = ws2.AutoFilter.Range.Columns(2).SpecialCells(xlCellTypeVisible).Count - 1
         Cnt = 0
         With ws2
            For Each cel2 In .Range("E2:E" & .Cells(.Rows.Count, "E").End(xlUp).Row) _
                .SpecialCells(xlCellTypeVisible)
               Cnt = Cnt + 1
               If Cnt < x Then
                  myQty = myQty & cel2.Value & "-" & cel2.Offset(0, -1).Value & ";"
               Else
                  myQty = myQty & cel2.Value & "-" & cel2.Offset(0, -1).Value
                  ws3.Cells(cel3.Row, "G").Value = myQty
                  myQty = ""
               End If
            Next cel2
         End With
      Next cel3
      ws2.AutoFilterMode = False
   End With
      ws2.Range("F:F").EntireColumn.Delete
      ws3.Range("H:H").EntireColumn.Delete
      ws3.Columns.AutoFit
      Application.ScreenUpdating = True
End Sub

Option Explicit
Sub Move_To_Dump()
   Dim sWS          As Worksheet
   Dim tWS          As Worksheet
   Dim sLR          As Long
   Dim tLR          As Long
   Dim tNR          As Long
   Set sWS = Sheets("Web Query")
   Set tWS = Sheets("Dump")
   With tWS
      tNR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row + 1
   End With
   With sWS
      sLR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row
      .Range("A10:AF" & sLR).Copy
      tWS.Cells(tNR, "A").PasteSpecial
   End With
   With tWS
      tLR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row
      .Range(.Cells(tNR - 1, "AG"), .Cells(tNR - 1, "BC")).AutoFill _
            Destination:=.Range(.Cells(tNR - 1, "AG"), .Cells(tLR, "BC"))
   End With
End Sub

Private Sub ComboBox1_Change()
   Me.ComboBox2.Enabled = True
End Sub
Private Sub ComboBox2_Change()
   Me.ComboBox3.Enabled = True
End Sub
Private Sub ComboBox3_Change()
   Me.TextBox1.Enabled = True
End Sub
Private Sub TextBox1_Change()
   Me.TextBox2.Enabled = True
End Sub
Private Sub TextBox2_Change()
   Me.TextBox3.Enabled = True
End Sub
Private Sub TextBox3_Change()
   Me.OptionButton1.Enabled = True
   Me.OptionButton2.Enabled = True
   Me.OptionButton3.Enabled = True
End Sub
Private Sub UserForm_Initialize()
   Dim Ctrl         As Control
   ComboBox1.AddItem ("1")
   ComboBox1.AddItem ("2")
   ComboBox1.AddItem ("3")
   ComboBox2.AddItem ("aaa")
   ComboBox2.AddItem ("bbb")
   ComboBox2.AddItem ("ccc")
   ComboBox3.AddItem ("111")
   ComboBox3.AddItem ("222")
   ComboBox3.AddItem ("333")
   For Each Ctrl In Me.Controls
      If Not Ctrl.Name = "ComboBox1" Then
         Ctrl.Enabled = False
      End If
   Next Ctrl
End Sub

Sub FindMyNubmer()
   Dim PART         As Variant
   Dim SEQ          As Integer
   'for projectile data
   Dim i            As Long
   Dim findString   As String
   Dim rs           As String
   Sheets("sheet5").Select
   findString = "HCAP2ENDS"
   Application.ScreenUpdating = False
   For i = 1 To Cells(Rows.Count, 16).End(xlUp).Row
      If Right(Cells(i, 16).Text, 16) = findString Then
         PART = Cells(i, "B").Value
         SEQ = Cells(i, "C").Value
         With Sheets("Data")
            For j = 1 To .Cells(.Rows.Count, 2).End(xlUp).Row
               If .Cells(j, "F").Value = "CAP" Then
                  If .Cells(j, "B").Value = PART Then
                     .Cells(j, "B").Offset(0, 1).Value = SEQ
                     With .Cells(j, "B").Offset(0, 1).Interior
                        .Pattern = xlSolid
                        .Color = 255
                     End With
                  End If
               End If
            Next j
         End With
      End If
   Next i
   Application.ScreenUpdating = True
End Sub