CODEWITHSUNDEEP
vbaexcel
Alan Treanor
Alan Treanor

Reputation: 159

Listbox Multiselect add to next available blank cell & remove from original range

Hopefully someone can help me? I have 2 list boxes RndAdd1 & RndEdit1. I want to be able to multi select items in RndAdd1 and then click Button1 and it loops through selected items and one at a time adds them to the new range (first blank cell) until all items added. Then remove all the values just added from the original range. (basically move from Column A to Column B for Monday, Column C to D for Tuesday and so on)

I also have another variable set (which day of the week) I have the following code I was going to place on the button then nest a series of if/Elseif statements.

The trouble I'm having currently is that it posts the first value in the first blank cell, then the 2nd value overwrites the first value and so on until only the final value is now visible in the new range. This is probably a simple fix and I'm just not thinking of it in the correct way! 

Dim lItem As Long
For lItem = 0 To RndAdd1.ListCount - 1
    If RndAdd1.Selected(lItem) = True Then
        If ComboBox1.Value = "Monday" Then
            Sheets("Setup").Range("B65536").End(xlUp)(0, 1) = RndAdd1.List(lItem)
            RndAdd1.Selected(lItem) = False
        End If
    End If
Next

RndAdd1.Clear
RndEdit1.Clear
ComboBox1.Clear
ComboBox1.List = Array("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")

ComboBox1.Value = "Monday"

'Tuesday Repeat Code but with different range to take round numbers from

Upvotes: 0

Views: 209

Answers (2)

Benoit Ranque
Benoit Ranque

Reputation: 114

I'm on my phone so cannot post code buy maybe this can help you:

Dim TargetRange as range 

Set TargetRange = thisworkbook.sheets(1).range("A1")  'or whereever you want it

Do until IsEmpty(TargetRange.value)
Set targetrange = targetrange.offset(1,0)
Loop

TargetRange.value = "your value here"

This loops down until it finds an empty cell

Hope it helps

Upvotes: 1

user3598756
user3598756

Reputation: 29421

substitute

Sheets("Setup").Range("B65536").End(xlUp)(0, 1) = RndAdd1.List(lItem)

with

With Sheets("Setup")
    .Range(.Rows.Count, "B").End(xlUp).Offset(1) = RndAdd1.List(lItem)
End With

Upvotes: 0

Related Questions