set parent child sheet distribution,Generating DropDown control in excel

Set parent child sheet distribution in excel

If you want to set excel worksheet as per parent and child sheet then you can try this example.
This is simple example to set parent child sheet distribution in excel.

 Sub Distribution(ByVal destflnm As String, ByVal srcflnm As String, ByVal ParentColumn As String, ByVal ChildColumn As String)  
 'Clear Destination Sheet  
 Dim RgClear As Range  
 Set RgClear = Worksheets(destflnm).Range("$A$1:$" & LastCol(destflnm) & "$" & LastRow(destflnm))  
 RgClear.Clear  
 'Set Parent Range  
 Dim RgParent As Range  
 Set RgParent = Worksheets(srcflnm).Range(ColumnRange(srcflnm, ParentColumn))  
 'Set Child Range  
 Dim RgChild As Range  
 Set RgChild = Worksheets(srcflnm).Range(ColumnRange(srcflnm, ChildColumn))  
 'Set Search Count  
 Dim i As Integer  
 i = RgParent.Count  
 'Set Column index for Destination Sheet  
 Dim ci As Integer  
 ci = 1  
 'Set row index for Destination Sheet  
 Dim ri As Integer  
 ri = 2  
 For r = 1 To i + 1  
 'if consicutive Parent are same then add Child in column  
 If RgParent(r, 1) = RgParent(r + 1, 1) Then  
 'adding Child  
 Worksheets(destflnm).Cells(ri, ci).Value = RgChild(r, 1)  
 'increasing row index  
 ri = ri + 1  
 'if consicutive Parent are not same then add last Child in column & put Parent as column name  
 Else  
 'adding last Child respectively to Parent  
 Worksheets(destflnm).Cells(ri, ci).Value = RgChild(r, 1)  
 'adding Parent as column name i.e. in first row  
 Worksheets(destflnm).Cells(1, ci).Value = RgParent(r, 1)  
 'increase column index  
 ci = ci + 1  
 'reset row index  
 ri = 2  
 End If  
 Next r  
 End Sub  

Generating DropDown control in excel

If you want to add dropdown control on excel sheet then you can Generate DropDown control in excel by using following code. You can set value in dropdown by code.

 Sub DropDowncreator(ByVal flnm As String, ByVal clnm As String, ByVal strRG As String)  
 'Set DropDown Selection Range  
 Dim strDRP As String  
 strDRP = ColumnRange(flnm, clnm)  
 'If Column Exist  
 If strDRP <> "" Then  
 'Set DropDown Unoptimized Range  
 Dim RgDRP As Range  
 Set RgDRP = Worksheets(flnm).Range(strDRP)  
 'Optimize Range  
 Dim iDrp As Integer  
 iDrp = RgDRP.Count  
 For q = 1 To iDrp + 1  
 'if get blank value then break  
 If RgDRP(q, 1) = "" Then  
 Dim CN As String  
 'Find column name of current set range  
 CN = ColumnAddress(flnm, clnm)  
 'optimized range string  
 strDRP = CN & "2:" & CN & q  
 q = iDrp + 1  
 End If  
 Next q  
 'Generating DropDown  
 Range(strRG).Select  
 With Selection.Validation  
 .Delete  
 .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _  
 xlBetween, Formula1:="=" & flnm & "!" & strDRP 'Range for DropDown  
 .IgnoreBlank = True  
 .InCellDropdown = True  
 .InputTitle = ""  
 .ErrorTitle = ""  
 .InputMessage = ""  
 .ErrorMessage = ""  
 .ShowInput = True  
 .ShowError = True  
 End With  
 End If  
 End Sub