Hi all, basically I've got 3 bits of code that i'm trying to stitch together and am only 1/2 way through my VBA for Dummies book... :)
What i'm trying to do is create an input form that appears with 2 options. Based on the option selected, one of 2 ranges will be identified and passed through to a function procedure as the input array.... after the function runs, I would like it's results (another array) to be passed through as the elements or variables(?) for another array in the sub procedure...
I have never used input forms before so i'm kind of lost right off the bat and i'm only really just starting to understand what my macro recorder's been doing for me all these years! :)
Currently I have a macro that creates what you see in the attached sample workbook... I would at this point run the code in Step 3 below, but I would like to modify by adding Setp 1 and 2 below at this point...
Step 1- User input... I have no idea how this is supposed to go, but I would like "OptionModelType" to select Range(=LEFT(B30:End(xlToRight),3) ie. In the last part of code below (Step 3) the code enters the first 3 characters of cell30 into cell1 for each column... if I do this first, then the desired range would be B1:B last column, obviously if the user input box is going to work here I will have to move that process to have already occurred before this point unless the range can be determined without this step at all? OptionModelName is basically the same range except for the full value in row 30 and not just the first 3 characters.
Code:
'No Idea What I'm supposed to do here...'
Private Sub GoButton1_Click()
End Sub
Private Sub OptionModelType_Click()
End Sub
Private Sub OptionModelName_Click()
End Sub
Private Sub UserForm_Click()
End Sub
once the user has made a selection and clicked "Go", I would like the selected range to be used as the input array in this function... By the way, this function has an optional count operation that I don't need, i'm just not 100% sure which code an can delete without messing it up, so I would like to have Count set to False automatically all the time.
Step 2- The UniqueItems Function
Code:
Option Base 1
Function UniqueItems(ArrayIn, Optional Count As Variant) As Variant
' Accepts an array or range as input
' If Count = True or is missing, the function returns the number of unique elements
' If Count = False, the function returns a variant array of unique elements
Dim Unique() As Variant ' array that holds the unique items
Dim Element As Variant
Dim i As Integer
Dim FoundMatch As Boolean
' If 2nd argument is missing, assign default value
If IsMissing(Count) Then Count = True
' Counter for number of unique elements
NumUnique = 0
' Loop thru the input array
For Each Element In ArrayIn
FoundMatch = False
' Has item been added yet?
For i = 1 To NumUnique
If Element = Unique(i) Then
FoundMatch = True
Exit For '(exit loop)
End If
Next i
AddItem:
' If not in list, add the item to unique list
If Not FoundMatch And Not IsEmpty(Element) Then
NumUnique = NumUnique + 1
ReDim Preserve Unique(NumUnique)
Unique(NumUnique) = Element
End If
Next Element
' Assign a value to the function
If Count Then UniqueItems = NumUnique Else UniqueItems = Unique
End Function
Finally this function produces a list of all the unique values in the input array, but rather than having them copied into cells, (unless that's a necessary step...) I would like this list of values to be passed through as the array elements for VArray in this next bit... ie. VArray = Array("results from this function" instead of the hard keyed variables in the code below)
Step 3- The rest... FYI I also don't want to delete any worksheets, but for some reason the code doesn't seem to delete them anyway... again, have been hesitant to remove any lines as the code still functions as is :)
Code:
Sub sSplitData()
Dim wsOriginal As Worksheet
Dim ws As Worksheet
Dim wsMaster As Worksheet
Dim lLC As Long, i As Long
Dim vElement, vArray
vArray = Array("IND", "OFF", "RET") ' Trying to get these elements input from previous function'
Dim rDelete As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
On Error Resume Next
Set wsOriginal = Sheets("Sheet3")
' delete all worksheets first (except the original)
For Each ws In ThisWorkbook.Sheets
Application.DisplayAlerts = False
If ws.Name <> wsOriginal.Name Then
ws.Delete
End If
Application.DisplayAlerts = True
Next 'ws
' make a copy of the original and name it "Master"
wsOriginal.Copy after:=Sheets(Sheets.Count)
Set wsMaster = ActiveSheet
wsMaster.Name = "Master"
' add column headings to "Master" worksheet...................... ' will need to move this earlier to before input form unless range can be determined without physically adding these values to row 1???'
With wsMaster
lLC = .Cells(4, .Columns.Count).End(xlToLeft).Column
For i = 2 To lLC
.Cells(1, i).Value = _
Left(.Cells(30, i).Value, 3)
Next 'i
End With
' copy Master worksheet to individual sheets
Application.DisplayAlerts = False
For Each vElement In vArray
wsMaster.Copy after:=Sheets(Sheets.Count)
Set ws = ActiveSheet
ws.Name = vElement
Next 'vElement
Application.DisplayAlerts = True
' delete Master worksheet
Application.DisplayAlerts = False
'wsMaster.Delete
Application.DisplayAlerts = True
' delete columns on each sheet
For Each vElement In vArray
Set ws = Sheets(vElement)
With ws
lLC = .Cells(1, .Columns.Count).End(xlToLeft).Column
For i = 2 To lLC
If .Cells(1, i).Value <> vElement Then
If rDelete Is Nothing Then
Set rDelete = .Cells(1, i)
Else
Set rDelete = Union(rDelete, .Cells(1, i))
End If
End If
Next 'i
If Not rDelete Is Nothing Then
rDelete.EntireColumn.Delete
End If
Set rDelete = Nothing
End With
Next 'vElement
' tidy up
On Error GoTo 0
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
I have attached a sample worksheet and any help would be very much appreciated! Also, in the original workbook, many of the values have formulas and vlookups, but in order to keep this small and simple I've just included values and formats in this sample...
sample3.xlsm
Thanks,
Joe