Copy data from listbox on userform to listbox and add header for each range

[abdo meghari]

Hello
I have this code to copy to the bottom when run the form to sheet

Private Sub CommandButton2_Click()
Dim rngNext As Range
Dim i As Long
Dim col As Long

    Set rngNext = Worksheets("NAMES").Range("A" & Rows.Count).End(xlUp).Offset(1)
   
    For i = 1 To ListBox1.ListCount - 1
   
            For col = 0 To ListBox1.ColumnCount - 1
                rngNext.Offset(, col).Value = ListBox1.List(i, col)
            Next col
           
            Set rngNext = rngNext.Offset(1)
    Next i
End Sub

and the formatting in sheet will be like this

DECREASE.xlsm
	A	B	C	D	E	F	G
1				NAMES
2
3	ITEM	DATE	INV.NO	CASE	DEBIT	CREDIT	BALANCE
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
NAMES

when try copy data from form to sheet I want copy name from combobox1 and put under header in column D so the result will be

should be

DECREASE.xlsm
	A	B	C	D	E	F	G
1				NAMES
2				CCF-1000
3	ITEM	DATE	INV.NO	CASE	DEBIT	CREDIT	BALANCE
4	1	30/06/2023			-	-500	-500
5	2	15/07/2023		RVCH20000	30,000.00	-	29,500.00
6	3	15/07/2023		RVCH20002	10,000.00	-	39,500.00
7	4	15/09/2023	BSTR_23448	OUTSANDING	-	2,300.00	37,200.00
8	5	15/09/2023	BSTR_23449	OUTSANDING	-	1,920.00	35,280.00
9	6	15/09/2023	BSTR_23450	PAID	50,400.00	-	85,680.00
10	7	15/09/2023	BSJ_23444	OUTSANDING	1,720.00	-	87,400.00
11	8	15/09/2023	BSJ_23446	PAID	-	4,900.00	82,500.00
12	9	15/09/2023	VSTR_23444	PAID	-	500	82,000.00
13	10	15/09/2023	VSTR_23446	OUTSANDING	3,600.00	-	85,600.00
14	11	15/09/2023	RSS_23222	OUTSANDING	-	860	84,740.00
15	12	15/09/2023		VCH20005	-	15,000.00	69,740.00
16	13	16/09/2023	VSTR_23449	PAID	-	3,760.00	65,980.00
17	14	16/09/2023	RSS_23224	PAID	2,950.00	-	68,930.00
18	SUM				98,670.00	28,740.00	69,930.00
NAMES

and if I select another name then should copy the same formatting as in original sheet based how many rows need it and leave two empty rows as break .
example

should be

DECREASE.xlsm
	A	B	C	D	E	F	G
1				NAMES
2				CCF-1000
3	ITEM	DATE	INV.NO	CASE	DEBIT	CREDIT	BALANCE
4	1	30/06/2023			-	-500	-500
5	2	15/07/2023		RVCH20000	30,000.00	-	29,500.00
6	3	15/07/2023		RVCH20002	10,000.00	-	39,500.00
7	4	15/09/2023	BSTR_23448	OUTSANDING	-	2,300.00	37,200.00
8	5	15/09/2023	BSTR_23449	OUTSANDING	-	1,920.00	35,280.00
9	6	15/09/2023	BSTR_23450	PAID	50,400.00	-	85,680.00
10	7	15/09/2023	BSJ_23444	OUTSANDING	1,720.00	-	87,400.00
11	8	15/09/2023	BSJ_23446	PAID	-	4,900.00	82,500.00
12	9	15/09/2023	VSTR_23444	PAID	-	500	82,000.00
13	10	15/09/2023	VSTR_23446	OUTSANDING	3,600.00	-	85,600.00
14	11	15/09/2023	RSS_23222	OUTSANDING	-	860	84,740.00
15	12	15/09/2023		VCH20005	-	15,000.00	69,740.00
16	13	16/09/2023	VSTR_23449	PAID	-	3,760.00	65,980.00
17	14	16/09/2023	RSS_23224	PAID	2,950.00	-	68,930.00
18	SUM				98,670.00	28,740.00	69,930.00
19
20
21				NAMES
22				CCF-1001
23	ITEM	DATE	INV.NO	CASE	DEBIT	CREDIT	BALANCE
24	1	30/06/2023			2,000.00	-	2,000.00
25	2	15/07/2023		RVCH20001	25,000.00	-	27,000.00
26	3	15/09/2023	VSTR_23445	OUTSANDING	1,000.00	-	28,000.00
27	4	16/09/2023	BSTR_23452	PAID	7,200.00	-	35,200.00
28	SUM				35,200.00	-	35,200.00
29
NAMES

I hope to find solve for this subject.
EDITED: subject should copy from listbox to sheet, not from listbox to listbox as show in topic,sorry!
thanks

 

[DanteAmor]

Replace your commandbutton2 code to:

Private Sub CommandButton2_Click()
  Dim lr As Long
  
  If ComboBox1.ListIndex = -1 Then
    MsgBox "Select Name"
    Exit Sub
  End If
  
  With Sheets("NAMES")
    If .Range("D2").Value = "" Then
      lr = 3
    Else
      lr = .Range("A" & Rows.Count).End(3).Row + 5
      .Range("A1:G3").Copy .Range("A" & lr - 2)
    End If
    
    'copy from combobox to sheet
    .Range("D" & lr - 1).Value = ComboBox1.Value
    'copy from listbox to sheet
    .Range("A" & lr).Resize(ListBox1.ListCount, ListBox1.ColumnCount).Value = ListBox1.List
    
    'Format cells
    .Range("B:B").NumberFormat = "dd/mm/yyyy"
    .Range("E:G").NumberFormat = "#,##0.00;-#,##0.00;-"
    .Range("A" & lr + 1, .Range("G" & Rows.Count).End(3)).Borders.LineStyle = xlContinuous
  End With
End Sub

 

[abdo meghari]

Hi Dante, again
the code is perfect .
I realized to forget this, sorry again for missed this details !
as you know every time the code copy to the bottom , but if I repeat copy for the same name and it's already existed I would replace data without repeat copy to the bottom.
sorry for I post missed details in this days!

 

[DanteAmor]

the code is perfect .

Try:

Private Sub CommandButton2_Click()
  Dim lr As Long
  Dim f As Range
  
  If ComboBox1.ListIndex = -1 Then
    MsgBox "Select Name"
    Exit Sub
  End If
  
  With Sheets("NAMES")
    Set f = .Range("D:D").Find(ComboBox1.Value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      MsgBox "The name already exists"
      Exit Sub
    End If

    If .Range("D2").Value = "" Then
      lr = 3
    Else
      lr = .Range("A" & Rows.Count).End(3).Row + 5
      .Range("A1:G3").Copy .Range("A" & lr - 2)
    End If
    
    .Range("D" & lr - 1).Value = ComboBox1.Value
    .Range("A" & lr).Resize(ListBox1.ListCount, ListBox1.ColumnCount).Value = ListBox1.List
    
    'Format cells
    .Range("B:B").NumberFormat = "dd/mm/yyyy"
    .Range("E:G").NumberFormat = "#,##0.00;-#,##0.00;-"
    .Range("A" & lr + 1, .Range("G" & Rows.Count).End(3)).Borders.LineStyle = xlContinuous
  End With
End Sub

 

[abdo meghari]

thanks
I'm not sure if this is complicated , but what I meant like
this

DECREASE.xlsm
	A	B	C	D	E	F	G
1				NAMES
2				CCF-1000
3	ITEM	DATE	INV.NO	CASE	DEBIT	CREDIT	BALANCE
4	1	30/06/2023			-	-500.00	-500.00
5	2	15/07/2023		RVCH20000	30,000.00	-	29,500.00
6	3	15/07/2023		RVCH20002	10,000.00	-	39,500.00
7	4	15/09/2023	BSTR_23448	OUTSANDING	-	2,300.00	37,200.00
8	5	15/09/2023	BSTR_23449	OUTSANDING	-	1,920.00	35,280.00
9	6	15/09/2023	BSTR_23450	PAID	50,400.00	-	85,680.00
10	7	15/09/2023	BSJ_23444	OUTSANDING	1,720.00	-	87,400.00
11	8	15/09/2023	BSJ_23446	PAID	-	4,900.00	82,500.00
12	9	15/09/2023	VSTR_23444	PAID	-	500.00	82,000.00
13	10	15/09/2023	VSTR_23446	OUTSANDING	3,600.00	-	85,600.00
14	11	15/09/2023	RSS_23222	OUTSANDING	-	860.00	84,740.00
15	12	15/09/2023		VCH20005	-	15,000.00	69,740.00
16	13	16/09/2023	VSTR_23449	PAID	-	3,760.00	65,980.00
17	14	16/09/2023	RSS_23224	PAID	2,950.00	-	68,930.00
18	SUM				98,670.00	28,740.00	69,930.00
19
20
21				NAMES
22				CCF-1001
23	ITEM	DATE	INV.NO	CASE	DEBIT	CREDIT	BALANCE
24	1	30/06/2023			2,000.00	-	2,000.00
25	2	15/07/2023		RVCH20001	25,000.00	-	27,000.00
26	3	15/09/2023	VSTR_23445	OUTSANDING	1,000.00	-	28,000.00
27	4	16/09/2023	BSTR_23452	PAID	7,200.00	-	35,200.00
28	SUM				35,200.00	-	35,200.00
NAMES

and when try to copy form

result

DECREASE.xlsm
	A	B	C	D	E	F	G
1				NAMES
2				CCF-1000
3	ITEM	DATE	INV.NO	CASE	DEBIT	CREDIT	BALANCE
4	1	30/06/2023			-	-500.00	-500.00
5	2	15/07/2023		RVCH20000	30,000.00	-	29,500.00
6	3	15/07/2023		RVCH20002	10,000.00	-	39,500.00
7	4	15/09/2023	BSTR_23448	OUTSANDING	-	2,300.00	37,200.00
8	5	15/09/2023	BSTR_23449	OUTSANDING	-	1,920.00	35,280.00
9	6	15/09/2023	BSTR_23450	PAID	50,400.00	-	85,680.00
10	7	15/09/2023	BSJ_23444	OUTSANDING	1,720.00	-	87,400.00
11	8	15/09/2023	BSJ_23446	PAID	-	4,900.00	82,500.00
12	9	15/09/2023	VSTR_23444	PAID	-	500.00	82,000.00
13	10	15/09/2023	VSTR_23446	OUTSANDING	3,600.00	-	85,600.00
14	11	15/09/2023	RSS_23222	OUTSANDING	-	860.00	84,740.00
15	12	15/09/2023		VCH20005	-	15,000.00	69,740.00
16	SUM				95,720.00	24,980.00	70,740.00
17
18
19				NAMES
20				CCF-1001
21	ITEM	DATE	INV.NO	CASE	DEBIT	CREDIT	BALANCE
22	1	30/06/2023			2,000.00	-	2,000.00
23	2	15/07/2023		RVCH20001	25,000.00	-	27,000.00
24	3	15/09/2023	VSTR_23445	OUTSANDING	1,000.00	-	28,000.00
25	4	16/09/2023	BSTR_23452	PAID	7,200.00	-	35,200.00
26	SUM				35,200.00	-	35,200.00
NAMES

 

[DanteAmor]

I'm not sure if this is complicated

In fact, yes it is. But try this:

Private Sub CommandButton2_Click()
  Dim lr As Long, k As Long, i As Long
  Dim f As Range
  
  If ComboBox1.ListIndex = -1 Then
    MsgBox "Select Name"
    Exit Sub
  End If
  
  With Sheets("NAMES")
    Set f = .Range("D:D").Find(ComboBox1.Value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      
      For i = f.Row + 2 To .Range("A" & Rows.Count).End(3).Row
        If .Range("A" & i).Value = "" Then
          .Rows(f.Row + 2 & ":" & i - 1).Delete
          .Rows(f.Row + 3 & ":" & f.Row + ListBox1.ListCount + 1).Insert Shift:=xlDown ', CopyOrigin:=xlFormatFromLeftOrAbove
          lr = f.Row + 1
          Exit For
        End If
      Next
    
    Else

      If .Range("D2").Value = "" Then
        lr = 3
      Else
        lr = .Range("A" & Rows.Count).End(3).Row + 5
        .Range("A1:G3").Copy .Range("A" & lr - 2)
      End If
    
    End If
    
    .Range("D" & lr - 1).Value = ComboBox1.Value
    .Range("A" & lr).Resize(ListBox1.ListCount, ListBox1.ColumnCount).Value = ListBox1.List
    
    'Format cells
    .Range("B:B").NumberFormat = "dd/mm/yyyy"
    .Range("E:G").NumberFormat = "#,##0.00;-#,##0.00;-"
    .Range("A" & lr + 1, .Range("G" & lr + ListBox1.ListCount - 1)).Borders.LineStyle = xlContinuous
  End With
End Sub

 

[abdo meghari]

In fact, yes it is

sorry !
I tested for CCF-1000,CCF-1001 works , but why not with CCF-1002 and the others !
gives error application defined error in this line

.Range("D" & lr - 1).Value = ComboBox1.Value

 

[DanteAmor]

This is important: You can explain what steps you took when the error occurred. And exactly what the error says.

After presenting the error, press the debug button, on the yellow line, bring the mouse pointer to the variable lr and take note of the number that appears in the window.

For example:

It also explains the conditions of the listbox when the error occurs, that is, how many records exist in the listbox.

 

[abdo meghari]

before

DECREASE.xlsm
	A	B	C	D	E	F	G
1				NAMES
2				CCF-1000
3	ITEM	DATE	INV.NO	CASE	DEBIT	CREDIT	BALANCE
4	1	30/06/2023			-	-500.00	-500.00
5	2	15/07/2023		RVCH20000	30,000.00	-	29,500.00
6	3	15/07/2023		RVCH20002	10,000.00	-	39,500.00
7	4	15/09/2023	BSTR_23448	OUTSANDING	-	2,300.00	37,200.00
8	5	15/09/2023	BSTR_23449	OUTSANDING	-	1,920.00	35,280.00
9	6	15/09/2023	BSTR_23450	PAID	50,400.00	-	85,680.00
10	7	15/09/2023	BSJ_23444	OUTSANDING	1,720.00	-	87,400.00
11	8	15/09/2023	BSJ_23446	PAID	-	4,900.00	82,500.00
12	9	15/09/2023	VSTR_23444	PAID	-	500.00	82,000.00
13	10	15/09/2023	VSTR_23446	OUTSANDING	3,600.00	-	85,600.00
14	11	15/09/2023	RSS_23222	OUTSANDING	-	860.00	84,740.00
15	12	15/09/2023		VCH20005	-	15,000.00	69,740.00
16	13	16/09/2023	VSTR_23449	PAID	-	3,760.00	65,980.00
17	14	16/09/2023	RSS_23224	PAID	2,950.00	-	68,930.00
18	SUM				98,670.00	28,740.00	69,930.00
19
20
21
22				NAMES
23				CCF-1001
24	ITEM	DATE	INV.NO	CASE	DEBIT	CREDIT	BALANCE
25	1	30/06/2023			2,000.00	-	2,000.00
26	2	15/07/2023		RVCH20001	25,000.00	-	27,000.00
27	3	15/09/2023	VSTR_23445	OUTSANDING	1,000.00	-	28,000.00
28	SUM				28,000.00	-	28,000.00
29
30
31				NAMES
32				CCF-1002
33	ITEM	DATE	INV.NO	CASE	DEBIT	CREDIT	BALANCE
34	1	30/06/2023			-	-	-
35	2	15/09/2023	BSJ_23447	PAID	-	6,000.00	-6,000.00
36	SUM				-	6,000.00	-6,000.00
37
38
39				NAMES
40				CCF-1003
41	ITEM	DATE	INV.NO	CASE	DEBIT	CREDIT	BALANCE
42	1	30/06/2023			1,000.00	-	1,000.00
43	2	15/07/2023		RVCH20003	1,200.00	-	2,200.00
44	3	16/09/2023	VSTR_23447	PAID	-	1,600.00	600.00
45	SUM				2,200.00	1,600.00	600.00
NAMES

after
when show data on form

when click commandbutto2

and lr=0

 

[DanteAmor]

Try:

Private Sub CommandButton2_Click()
  Dim lr As Long, k As Long, i As Long
  Dim f As Range
  
  If ComboBox1.ListIndex = -1 Then
    MsgBox "Select Name"
    Exit Sub
  End If
  
  With Sheets("NAMES")
    Set f = .Range("D:D").Find(ComboBox1.Value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      
      For i = f.Row + 2 To .Range("A" & Rows.Count).End(3).Row + 1
        If .Range("A" & i).Value = "" Then
          .Rows(f.Row + 2 & ":" & i - 1).Delete
          .Rows(f.Row + 3 & ":" & f.Row + ListBox1.ListCount + 1).Insert Shift:=xlDown ', CopyOrigin:=xlFormatFromLeftOrAbove
          lr = f.Row + 1
          Exit For
        End If
      Next
    
    Else

      If .Range("D2").Value = "" Then
        lr = 3
      Else
        lr = .Range("A" & Rows.Count).End(3).Row + 5
        .Range("A1:G3").Copy .Range("A" & lr - 2)
      End If
    
    End If
    
    .Range("D" & lr - 1).Value = ComboBox1.Value
    .Range("A" & lr).Resize(ListBox1.ListCount, ListBox1.ColumnCount).Value = ListBox1.List
    
    'Format cells
    .Range("B:B").NumberFormat = "dd/mm/yyyy"
    .Range("E:G").NumberFormat = "#,##0.00;-#,##0.00;-"
    .Range("A" & lr + 1, .Range("G" & lr + ListBox1.ListCount - 1)).Borders.LineStyle = xlContinuous
  End With
End Sub