Trouble with Loop looking for blank cells

[KristenT]

Hey guys, having a problem here.
Below is the code that I've written, and mostly it works... just one minor (ok, major) point that isn't.
This is connected to a User form with inputs PartNo, Count, and UOM. What I want is for the user to be able to enter the three values and have it search down the list to see if there is a matching value. If there is, I want it to add the counts together. If there isn't, I want it to search for the next blank and write the values in. If the partno already exists it's working fine, it's the blank that I can't figure out. My loop isn't working properly and I keep getting interrupted by a screaming boss so I can't even tell if my logic is right. Please help! Thank you. Kristen

ActiveWorkbook.Sheets("Data").Activate
Range("A2").Select
        
    If ActiveCell = "" Then
        ActiveCell.Value = PartNo.Value
        ActiveCell.Offset(0, 3) = Price.Value
        ActiveCell.Offset(0, 2) = Count.Value
        ActiveCell.Offset(0, 1) = UOM.Value
    Else:
        Do
        If ActiveCell = PartNo.Value Then
            ActiveCell.Offset(0, 3) = Price.Value
            ActiveCell.Offset(0, 2) = ActiveCell.Offset(0, 2) + Count.Value
            ActiveCell.Offset(0, 1) = UOM.Value
        Else
            ActiveCell.Offset(1, 0).Select
     
        Loop Until IsEmpty(ActiveCell) = True
     End If
     
    End If

 

[KristenT]

Righto, If the partno is already present in column A then I want it to add together the value in C with the value that it would normally write to C (count). If it is NOT present then I want it to find the end of the list and write it there as normal. I can get it to add the values and I can get it to find the new row, what I am having trouble with is the code to get it to compare the Column A values OR/then find the next blank row.

 

[Norie]

Kristen

Try this code.

Private Sub UserForm_Initialize()
Dim LastRow As Long
    
    LastRow = Sheets("ItemList").Range("A" & Rows.Count).End(xlUp).Row
    PartNo.RowSource = "ItemList!A2:A" & LastRow
    
    LastRow = Sheets("UOMList").Range("A" & Rows.Count).End(xlUp).Row
    UOM.RowSource = "UOMList!A2:A" & LastRow
    ActiveWorkbook.Sheets("Data").Activate

End Sub

Private Sub SubmitButton_Click()
Dim PartRow As Range
Dim LastRow As Long
Dim arrValues

    If Trim(Me.PartNo.Value) = "" Then
        MsgBox "Please enter a Part Number to Proceed"
        Me.PartNo.SetFocus
        Exit Sub
    End If

    If Trim(Me.Count.Value) = "" Then
        MsgBox "Please enter a Count to Proceed"
        Me.Count.SetFocus
        Exit Sub
    End If
    
    LastRow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
    With Worksheets("Data")
        Set PartRow = .Range("A2:A" & LastRow).Find(PartNo.Value, .Range("A2"), , xlWhole)
    End With
    
    If PartRow Is Nothing Then
        arrValues = Array(PartNo.Value, UOM.Value, Count.Value, Price.Value)
        Range("A" & LastRow + 1).Resize(, 4) = arrValues
    Else
        arrValues = Array(PartNo.Value, UOM.Value, Val(Count.Value) + Range("C" & PartRow.Row), Price.Value)
        Range("A" & PartRow.Row).Resize(, 4) = arrValues
    End If
    
    Unload Me
    
    DataForm.Show
End Sub

 

[HalfAce]

Hello Kristen,
If you replace your existing code for the Submit button on your userform (just comment it
out until you're sure this works!) does this do what you're after?

Private Sub SubmitButton_Click()

If Trim(Me.PartNo.Value) = "" Then
    MsgBox "Please enter a Part Number to Proceed"
    Me.PartNo.SetFocus
    Exit Sub
End If

If Trim(Me.Count.Value) = "" Then
    MsgBox "Please enter a Count to Proceed"
    Me.Count.SetFocus
    Exit Sub
End If

Dim fCell As Range, Rng As Range, LstRw As Long
LstRw = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
ThisWorkbook.Sheets("Data").Activate
Set Rng = Sheets("Data").Range("A2:A" & LstRw)
Set fCell = Rng.Find(PartNo, lookat:=xlWhole)
If Not fCell Is Nothing Then 'PART NUMBER WAS FOUND
    fCell.Offset(0, 3) = Price.Value
    fCell.Offset(0, 2) = ActiveCell.Offset(0, 2) + Count.Value
    fCell.Offset(0, 1) = UOM.Value
  Else 'PART NUMBER WAS NOT FOUND
    With Cells(LstRw + 1, "A")
      .Value = PartNo.Value
      .Offset(, 1).Value = UOM.Value
      .Offset(, 2).Value = Count.Value
      .Offset(, 3).Value = Price.Value
    End With
End If

Call userform_Initialize
    PartNo.Value = ""
    PartNo.SetFocus

End Sub

 

[KristenT]

Thanks guys. I used Norie's code, that worked for me.

Now I need to compare column B to ensure that it matches as well, but I'll try to figure that out on my own first!

*** actually, if they are different UOM then they have different part numbers anyways. *phew*

Thanks so much!

 

[Norie]

Kristen

I think that's going to be slighlty harder.

You'll have to find all instances of the PartNo then compare the UOM.

Actually as I write this, it doesn't actually sound too hard.

Give it a go and post back if you need any help.

 

[KristenT]

See my edit. I have much more important things to do that acutally make money for the company instead of just saving a few dollars a week! I'm sure you guys have other poor souls to help too. Thanks again, I'm sure I'll be back!