Excel Userform, Listbox Find and Copy Contents to worksheet

[StjepanJones]

Hello,

I'm an extreme beginner to VBA. I'm trying to create a Userform for this Excel Workbook I'm putting together.

I have 3 worksheets that I'm working with: PPE, Compcode, and Company Configure. PPE and Compcode will be hidden when I'm done, and I want the Userform to be available in Configure Company.

The Userform contains two ListBoxes, ListBox1 and ListBox2, and 3 Buttons, Add Company, Remove Company, and Generate Worksheet.
ListBox1 lists all of the PPE items from the PPE worksheet. The worksheet itself has 2 columns (UniqPPE and PPE). I can select the companies that I want and move them over to ListBox2.

***This is as far as I got.***

What I would like to do, once the companies are selected, is choose Generate Worksheet and have it search the Compcode worksheet (UniqPPE, PPE, ICO, Origination Addrees, NAIC, Lookup Code) for all of the items with the same UniqPPE selected on PPE, and have those items copied and pasted into the Configure Company worksheet.

This is the code I have so far:

Option Explicit
Private Sub btnMoveRight_Click()
Dim iCtr As Long
For iCtr = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(iCtr) = True Then
Me.ListBox2.AddItem Me.ListBox1.List(iCtr)
End If
Next iCtr
For iCtr = Me.ListBox1.ListCount - 1 To 0 Step -1
If Me.ListBox1.Selected(iCtr) = True Then
Me.ListBox1.RemoveItem iCtr
End If
Next iCtr
End Sub
Private Sub btnMoveLeft_Click()
Dim iCtr As Long
For iCtr = 0 To Me.ListBox2.ListCount - 1
If Me.ListBox2.Selected(iCtr) = True Then
Me.ListBox1.AddItem Me.ListBox2.List(iCtr)
End If
Next iCtr
For iCtr = Me.ListBox2.ListCount - 1 To 0 Step -1
If Me.ListBox2.Selected(iCtr) = True Then
Me.ListBox2.RemoveItem iCtr
End If
Next iCtr
End Sub
Private Sub UserForm_Initialize()
Dim lb As msforms.ListBox
Dim rcArray() As Variant
Dim lrw As Long, lcol As Long
Dim rngTarget As Range
Set rngTarget = Worksheets("PPE").Range("B2:B335")
ReDim Preserve rcArray(1 To rngTarget.Rows.Count, 1 To rngTarget.Columns.Count)
With rngTarget
For lcol = 1 To .Columns.Count
For lrw = 1 To .Rows.Count
rcArray(lrw, lcol) = rngTarget.Cells(lrw, lcol)
Next lrw
Next lcol
End With
Set lb = Me.ListBox1
With lb
.ColumnCount = 1
.ColumnWidths = "100"
.List = rcArray
End With
Me.ListBox1.MultiSelect = fmMultiSelectMulti
Me.ListBox2.MultiSelect = fmMultiSelectMulti

End Sub
Private Sub btnGenerate_Click()
End Sub

**************
I'm at a loss for where to go from here.

I can send along the file I'm working with. Anyone have any ideas?

 

[StjepanJones]

Bump.

 

[StjepanJones]

I have a module that sort of works. The problem is it only copies for my first selection and not all of my selections. Can someone shed some light on this, what I can do, etc.?

************************************************

Sub Testing(ByVal sName As String)

Dim sPPE As String
Dim sICO As String
Dim sAddr As String
Dim sNAIC As String
Dim sLookupCode As String
Dim iDestStart As Integer
iDestStart = 20
For i = 1 To 1270
If Worksheets("CompCode").Cells(i, 2) = sName Then
sPPE = Worksheets("CompCode").Cells(i, 2)
sICO = Worksheets("CompCode").Cells(i, 3)
sAddr = Worksheets("CompCode").Cells(i, 4)
sNAIC = Worksheets("CompCode").Cells(i, 5)
sLookupCode = Worksheets("CompCode").Cells(i, 6)
Worksheets("Configure Company").Cells(iDestStart, 2) = sPPE
Worksheets("Configure Company").Cells(iDestStart, 3) = sICO
Worksheets("Configure Company").Cells(iDestStart, 4) = sAddr
Worksheets("Configure Company").Cells(iDestStart, 5) = sNAIC
Worksheets("Configure Company").Cells(iDestStart, 6) = sLookupCode
iDestStart = iDestStart + 1
End If
Next i

End Sub

 

[StjepanJones]

Anyone have anything on this? Can it even be done?