copy data from listbox to sheet after headers and before Total row

Mussa

Active Member
Joined
Jul 12, 2021
Messages
264
Office Version
  1. 2019
  2. 2010
Hi
I have this code to copy data from listbox to sheet
VBA Code:
Private Sub cmdSend_Click()
    With Me.ListBox1
        If .ListCount > 0 Then
            Sheets("SL").[a7].Resize(.ListCount, .ColumnCount) = .List
        End If
    End With
End Sub
bu I need adapting by copy after row6 and before total row and if I have rows in listbox more than empty rows inside the sheet then should insert new rows with the same borders ,if I have rows in listbox less than empty rows inside the sheet then should delete empty rows

here is the structure inside sheet
Sample.xlsm
ABCDE
6ITEMIDQTYUNIT PRICETOTAL
7
8
9
10TOTAL.00
SL
Cell Formulas
RangeFormula
E10E10=SUM(E7:E9)


when fill listbox
1.JPG


the result should be
Sample.xlsm
ABCDE
6ITEMIDQTYUNIT PRICETOTAL
71ABSS-1001010.00100.00
82*** TYYY 20001222.00264.00
93ASDE9900/1200222.0044.00
104XDD*7777 212.0024.00
11TOTAL432.00
SL
Cell Formulas
RangeFormula
E11E11=SUM(E7:E10)
 
Code:
Sub What_Is_The_Answer()
Dim c As Range
    With Sheets("SL")
        Set c = .Columns(1).Find("TOTAL", , , 1)
        If Not c Is Nothing Then
            MsgBox "The word ""Total"" is at " & c.Address
                Else
            MsgBox "No such value in Column A."
        End If
    End With
MsgBox Len(ActiveSheet.Name)
End Sub

What do you get when you run this snippet?
 
Last edited:
Upvote 0

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
It all works on a workbook I made here. Maybe someone else sees the problem.
 
Upvote 0
@Mussa
Maybe this:
I'm assuming:
1. You've already populate the listbox using .List property as jolivanes suggested:
In the UserForm Module (Change the Range to the needed amount and where the data is.)
Code:
Private Sub UserForm_Initialize()
Me.ListBox1.List = Sheets("Sheet1").Range("L2:N" & Sheets("Sheet1").Cells(Rows.Count, 12).End(xlUp).Row).Value
End Sub

2. Maximum data is 10000 row.
3. Data always start at row 7
4. TOTAL row already exist.
The code will insert n empty rows below row 7, at the end any empty rows will be deleted.
VBA Code:
Private Sub cmdSend_Click()
Dim k As Long, n As Long

With Sheets("SL")
    k = .Range("A" & Rows.Count).End(xlUp).Row
    n = 10000  'max data is 10000 row, change to suit
    .Range("A8").Resize(n).EntireRow.Insert (xlUp) 'insert n rows
End With
   
    With Me.ListBox1
        If .ListCount > 0 Then
            Sheets("SL").[a7].Resize(.ListCount, .ColumnCount) = .List
        End If
    End With

Sheets("SL").Range("A8").Resize(n + k).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub
 
Upvote 0
Hi Akuini,
it's perfect !
just I need replace new data with old data have already existed from listbox to sheet . I don't need to copy to the bottom inside the sheet as the code does it
in other meaning should clear data under headers before copy data from listbox.
thanks .
 
Upvote 0
Are you saying there's probably existing data before you run the code & you need to remove it first?
Try this:
VBA Code:
Private Sub cmdSend_Click()
Dim k As Long, n As Long
Dim c As Range
With Sheets("SL")
    Set c = Range("A:A").Find(What:="TOTAL", LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
    Range("A7:A" & c.Row - 1).ClearContents
    k = .Range("A" & Rows.Count).End(xlUp).Row
    n = 10000  'max data is 10000 row, change to suit
    .Range("A8").Resize(n).EntireRow.Insert (xlUp) 'insert n rows
End With
   
    With Me.ListBox1
        If .ListCount > 0 Then
            Sheets("SL").[a7].Resize(.ListCount, .ColumnCount) = .List
        End If
    End With

Sheets("SL").Range("A8").Resize(n + k).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub
 
Last edited:
Upvote 0
Solution
Still can't figure out why the error.
What about this?
Code:
Private Sub CommandButton1_Click()
Dim sh4 As Worksheet    '<---- Change as required
Set sh4 = Worksheets("Sheet4")    '<---- Change as required
With sh4    '<---- Change as required
    .Cells(1).Offset(6).Resize(Cells(Rows.Count, 1).End(xlUp).Row - 6, 5).Delete Shift:=xlUp
    .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(Me.ListBox1.ListCount, Me.ListBox1.ColumnCount).Value = ListBox1.List
With .Cells(Rows.Count, 1).End(xlUp).Offset(1)
    .Value = "TOTAL"
    .Interior.Color = RGB(255, 255, 0)
    .Offset(, 4).Formula = "=SUM(E7:E" & Cells(Rows.Count, 1).End(xlUp).Row - 1 & ")"
End With
End With
Cells(1).Offset(6).Resize(Cells(Rows.Count, 1).End(xlUp).Row - 6, 5).HorizontalAlignment = xlCenter
Unload Me
End Sub

One of the suggestions, Akuini's or this one, should work for you.
 
Upvote 0
Still can't figure out why the error.
What about this?
finally it works but except one thing . it delete the borders .
anyway thank you .
 
Upvote 0
You're welcome, glad to help & thanks for the feedback.:)
 
Upvote 0

Forum statistics

Threads
1,224,824
Messages
6,181,187
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top