loop through listbox

[longhorn23]

I actually have another issue...

In my listboxes, I have more than one value thats in them and I'm trying to "loop" through that, say for example, one listbox. While it's looping, it should go and find that value in Sheet1 of my workbook (which is always going to be in row1), and when it finds that value in Sheet1, it should just copy that whole column [or store it in the range property]. (The columns won't always be in order. I'll have to copy column E, then H, L, etc..).


Here's my code under that button so far...(I just need to figure out how to loop though listboxes).

Private Sub btnCreateSheet_Click()

' declare multiple ranges
Dim r1 As Range, r2 As Range, multiarearange As Range

If Me.listboxAllSheets.ListCount = 1 Then
' get value from listboxNewSheet
Dim listboxallvalue As String
listboxallvalue = CStr(Me.listboxAllSheets.List(0))
' select row one and search for listboxvalue within that row
Rows("1:1").Select
Selection.Find(What:=listboxallvalue, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

c = ActiveCell.Column
' select that column(s) to be copied over to next column
lastrow1 = ActiveSheet.UsedRange.Rows.Count
Set r1 = Range(ActiveCell.Address, Cells(lastrow1, c))

End If

If Me.listboxNewSheet.ListCount = 1 Then
' get value from listboxNewSheet
Dim listboxnewvalue As String
listboxnewvalue = CStr(Me.listboxNewSheet.List(0))
' select row one and search for listboxvalue within that row
Rows("1:1").Select
Selection.Find(What:=listboxnewvalue, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

rr = ActiveCell.Row
cc = ActiveCell.Column
' select that column(s) to be copied over to next column
lastrow2 = ActiveSheet.UsedRange.Rows.Count
Set r2 = Range(ActiveCell.Address, Cells(lastrow2, cc))

End If

' select & copy the multiple ranges
Set multiarearange = Union(r1, r2)
multiarearange.Select
Selection.Copy

' create sheet
Dim SheetName As String

With ActiveWorkbook.Sheets
.Add After:=Worksheets(Worksheets.Count)
End With

SheetName = ActiveSheet.Name


Dim namesheet As String
' rename the sheet equal to first item in listboxNewSheet and if there is no value in that listbox use the AllSheets one
If Me.listboxNewSheet.ListCount = 0 Then
namesheet = Me.listboxAllSheets.List(0)
Else
namesheet = Me.listboxNewSheet.List(0)
End If


On Error Resume Next
ActiveSheet.Name = namesheet
NoName: If Err.Number = 1004 Then ActiveSheet.Name = InputBox("Rename sheet to:")

If ActiveSheet.Name = ActNm Then GoTo NoName
On Error GoTo 0

' paste copied sheet1 cells into new sheet
ActiveSheet.Paste


End Sub

[royUK]

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the # at the top of your post window. For more information about these and other tags, found here