Part 2 : Few Details required of Individual's Name with Range Address in ComboBox

[SamDsouza]

Hello

Wanted the List of Individuals Name with their Range Address uploaded in combobox

So when the form is initialized all the individual's name with range address is displayed in the combobox
When clicking on each name in combobox i get the respective information in respective textboxes.
in continuation with thread no: 1097415

In combobox it should display like
jerry A1:D10
mike A12:D19
Kate A21:D34
Steve A36:D42

Following is the Structure of worksheet :

	A	B	C	D
1	Individual Name:	Jerry
2	Transaction Date	Description	Payments Made	Payments Received
3	02-04-2015	vchr no : 2	600
4		sfdfdsf
5	03-04-2015	vchr no : 3	200
6		rerrt
7	04-04-2015	Agst vchr no : 2		600
8		rwewrew
9	Total		800	600
10	Balance :			200
11
12	Individual Name:	Mike
13	Transaction Date	Description	Payments Made	Payments Received
14	02-04-2015	vchr no : 4	1750
15		gfhfhgfhgf
16	03-04-2015	Agst vchr no : 4		350
17		oipoiopo
18	Total		1750	350
19	Balance :			1400
20
21	Individual Name:	Kate
22	Transaction Date	Description	Payments Made	Payments Received
23	01-04-2015	vchr no : 5	1500
24		dfgfgff
25	05-04-2015	vchr no : 6	600
26		fsfdsfds
27	06-04-2015	Agst vchr no : 12		2000
28		fdfds
29	09-04-2015	Agst vchr no : 5		1500
30		ggfgfgfg
31	10-04-2015	Agst vchr no : 2		300
32		fdfdsfds
33	Total		2100	3800
34	Balance :		1700
35
36	Individual Name:	Steve
37	Transaction Date	Description	Payments Made	Payments Received
38	02-04-2015	vchr no : 4	1235
39		dfdsfds
40	03-04-2015	Agst vchr no : 4		1235
41		fdfdsf
42	Total		1235	1235

<tbody>
</tbody>

Thanks
SamD

 

[nemmi69]

So for this example I have the list in column "H"
With single occurance Textbox names as
TB_Name
TB_TotalPayMade
TB_TotalPayRec
TB_Balance
Then remainder as
TB_Name(1-8)
TB_Description(1-16)
TB_PayMade(1-8)
TB_PayRec(1-8)

In module

Option Explicit
Public LastRowNo As Long
Public ListRange As String


Sub PrimeCombo()
LastRowNo = ActiveSheet.Range("H65536").End(xlUp).Row
ListRange = "$H$1:$H$" & LastRowNo
UserForm1.ComboBox1.List = ActiveSheet.Range(ListRange).Value
UserForm1.Show


End Sub

In Combobox1

Option Explicit


Private Sub ComboBox1_Change()
Dim StartRow As Long
Dim Lastrow As Long
Dim SelRange As String
Dim SelText As String
Dim XText As String
Dim TransLoop As Long


'Extract address
SelText = UserForm1.ComboBox1.Value
SelRange = Mid(SelText, InStr(SelText, " ") + 1, Len(SelText))
'Extract rows
StartRow = CInt(Mid(SelRange, 2, InStr(1, SelRange, ":") - 2))
Lastrow = CInt(Mid(SelRange, InStr(2, SelRange, ":") + 2, Len(SelRange)))
'Only 8 transactions per customer
If (Lastrow - StartRow >= 4) And (StartRow > 0) And (((Lastrow - StartRow) + 1 - 4) / 2) <= 8 Then
    'Write single lines
    UserForm1.TB_Name = Sheets("Sheet1").Range("B" & StartRow).Value
    UserForm1.TB_TotalPayMade = Sheets("Sheet1").Range("C" & Lastrow - 1).Value
    UserForm1.TB_TotalPayRec = Sheets("Sheet1").Range("D" & Lastrow - 1).Value
    UserForm1.TB_Balance = Sheets("Sheet1").Range("C" & Lastrow).Value
    'Descriptions 1st
    For TransLoop = 1 To (Lastrow - StartRow) + 1 - 4
        UserForm1.Controls("TB_Description" & TransLoop).Value = Sheets("Sheet1").Range("B" & StartRow + TransLoop + 1).Value
    Next TransLoop
    'Remainder of transactions
    For TransLoop = 1 To (((Lastrow - StartRow) + 1 - 4) / 2)
        UserForm1.Controls("TB_TransDate" & TransLoop).Value = Format(Sheets("Sheet1").Range("A" & StartRow + (TransLoop * 2)).Value, "dd/mm/yyyy")
        UserForm1.Controls("TB_PayMade" & TransLoop).Value = Sheets("Sheet1").Range("C" & StartRow + (TransLoop * 2)).Value
        UserForm1.Controls("TB_PayRec" & TransLoop).Value = Sheets("Sheet1").Range("D" & StartRow + (TransLoop * 2)).Value
    Next TransLoop
End If
End Sub

 

[SamDsouza]

thanks Nemmi69 for the start

So for this example I have the list in column "H"
With single occurance Textbox names as
TB_Name
TB_TotalPayMade
TB_TotalPayRec
TB_Balance
Then remainder as
TB_Name(1-8)
TB_Description(1-16)
TB_PayMade(1-8)
TB_PayRec(1-8)

what do i have to with above details copy the same in column h or copy what in column h. if you can show in the columnar form will appreciate it
without above clarity i think i am stuck

Also the following code i found in this Forum but changed one variable to suit but shows all the values of column B.
what i want is the individual name and range address in combobox and not all values of column b . it shows all the values of colb with range address

Public Sub GetIndividual_Name_Range()

  Dim Ray() As String
  Dim C As Range, LastA As Range, fnd As Range
  Dim rws As Long, k As Long
  Sheet1.Activate
  
  Set LastA = Sheet1.Range("A" & Range("D" & Rows.Count).End(xlUp).Row)

   For Each fnd In Sheet1.Range("B1", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlConstants)
    rws = 1

If IsEmpty(fnd.Offset(1).Value) And fnd.Address <> LastA.Address Then rws = rws + Sheet1.Range(fnd, LastA).SpecialCells(xlConstants).Areas(1).Rows.Count

    k = k + 1
    ReDim Preserve Ray(1 To k)
    Ray(k) = fnd.Value & " " & fnd.Resize(rws, 6).Address(0, 0)
  Next fnd
  ComboBox1.List = Ray

End Sub

SamD

 

[nemmi69]

In H1 down would be your list
jerry A1:D10
mike A12:D19
Kate A21:D34
Steve A36:D42

 

[SamDsouza]

Really i've not tried applying any combobox/textbox on worksheet. Always have used on userform. so how could i create the same on worksheet.

 

[nemmi69]

The module code will read of the worksheet and generate an address. This is set as the list that your combobox will use on your userform.

 

[Fluff]

How about

Private Sub UserForm_Initialize()
   Dim Rng As Range
   
   For Each Rng In Sheet1.Range("B:B").SpecialCells(xlConstants).Areas
      With Me.ComboBox1
         .AddItem Rng(1).Value
         .List(.ListCount - 1, 1) = Rng.CurrentRegion.Address(0, 0)
      End With
   Next Rng
   Me.ComboBox1.ColumnCount = -1
   Me.ComboBox1.ColumnWidths = "50;50"
End Sub

 

[SamDsouza]

Thanks Fluff . The PERFECT one

Such short and really efficient coding.
This is what was required
Thank you so much

SamD

 

[Fluff]

You're welcome & thanks for the feedback