modified code copy data from userform to the empty last columns Solved/Closed

Question

hello 
this  is  the  first  post  in  this  forum  and  I  hope  finding  solution  here 
I  got  this  code  from  the  internet  and  works   well    but  I  need  some  adjusting  so  the  code  copy  data    from  userform (textbox1,2,3) to  sheet   column b,c,d   after  select  from  combobox  based  on  column  a     the  column a  contains  many  items  so   the  copy   occurs   for  specific item  in  column  a   and  insert  row   before  the  total   
so  what   I  want    add   in  userform   textbox4,5    so  when  I   fill data   for  specific item   then  textbox1,2,3  always   copies  in  column b,c,d   but  the  texbox4,5  should  copy  to   two empty  last column   because  every  month  I  have  to  insert  two  columns   so  the  empty  columns changes every  month  
as for  to  insert  the  empty  row  before  total    the  original  code  does  that   but  it  has  to  be  empty row  before  total   row      I  don't   want  any   empty  row  before  the  total   it  should  insert   empty row and  fill it   when  I  fill  data  from  userform 

Private Sub CommandButton1_Click()    Application.ScreenUpdating = False    Dim fnd As Range, SH As Worksheet, DEMPTY As Long, LR As Long    Set SH = Sheets("SH1")    LR = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row    Set fnd = SH.Range("A:A").Find(ComboBox1.Value, LookIn:=xlValues, lookat:=xlWhole)    If Not fnd Is Nothing Then        With SH            DEMPTY = .Range("B" & fnd.Row - 1 & ":B" & LR).Find("", SearchOrder:=xlByRows, SearchDirection:=xlNext).Row            Range("B" & DEMPTY).Resize(, 4).Copy            Range("B" & DEMPTY + 1).Insert shift:=xlDown            .Range("B" & DEMPTY).Resize(, 3).Value = Array(TextBox1.Value, TextBox2.Value, TextBox3.Value)            Application.CutCopyMode = False        End With    End If    TextBox1 = ""    TextBox2 = ""    TextBox3 = ""    ComboBox1 = ""    Application.ScreenUpdating = TrueEnd Sub 
thanks

TrowaD · Answer

Hi LeapOut,

I find your query hard to understand.

You want to find the combobox value in column A. Then use that row to enter data from textbox 1, 2 and 3 into column B, C and D. So i guess those cells are empty, right? Then on the same row, you want to find the last used column to place the values from textbox 4 and into those column. So in your sheet you have a value in column A, then B, C and D are empty and then for example E, F and G contain values.

And then you want to insert that row of data to the row before the totals row (last row)?

Sample data before code:


Sample data after code:
  

Did I understand you correctly?

Best regards,
Trowa

TrowaD · Answer

Hi Leapout,

So you search column A for Item (Combobox1).
- Not found, then add another Item at the bottom of your table.
- When found, then search column B for brand (Textbox1)
- - Not found, then insert a row above the Total row for that Item.
- - When found, then use that row to enter Import (Textbox4) and Export (Textbox5) values.

How do we know for which month to put the Import and Export values? Is it always the last month? This is confusing as you said to enter the data in the first empty columns, but for Brand BB that would be columns E and F, but you placed them in columns H and I.

Also, can an Item be 'not found' or is your Item list complete?

Do you have a limit to the amount of months? Like this sheet has 12 months to complete the year and then the next year you move to the next sheet or different file? Or do you just keep adding month?

It is getting pretty complex. Keep in mind that creating a solution, once it is clear what you want, will take some time.

Best regards,
Trowa

leapout · Answer

Hi Trowa , 
about   the  items  , indeed  I added  manually   , but  I wish  do  that  by  userform    you  can  add another  textbox  to  add it   but  if  you  add  a new   textbox  for a new  item it  should  add it  after  row  contains TOTAL  I  prefer  do  that  by  userform  if  you  see  this  is  not  right  way   , you  can  do  manually ,  I 'm  open  for  all  suggestion

TrowaD · Answer

Hi Leapout,

Just so we are on the same page, could you give the following code a try. You can then point out the things you want to add/change. 

The code requires there is always a free/empty month available with a formula in the last column used (which is the NET column).
The code also requires that the Item is always found.

Here is the code:
Private Sub CommandButton1_Click()
Dim iFind, bFind As Range
Dim fRow, lRow As Long

Set iFind = Columns("A").Find(ComboBox1.Value)
fRow = iFind.Row
lRow = iFind.End(xlDown).Row - 2

Set bFind = Range(Cells(fRow, "B"), Cells(lRow, "B")).Find(TextBox1.Value)
If bFind Is Nothing Then
    Rows(lRow).Copy
    Rows(lRow).Insert shift:=xlUp
    Rows(lRow + 1).SpecialCells(xlCellTypeConstants).ClearContents
    Cells(lRow + 1, "B").Value = TextBox1.Value
    Cells(lRow + 1, "C").Value = TextBox2.Value
    Cells(lRow + 1, "D").Value = TextBox3.Value
    Cells(lRow + 1, Columns.Count).End(xlToLeft).Offset(0, -2).Value = TextBox4.Value
    Cells(lRow + 1, Columns.Count).End(xlToLeft).Offset(0, -1).Value = TextBox5.Value
Else
    Cells(bFind.Row, Columns.Count).End(xlToLeft).Offset(0, -2).Value = TextBox4.Value
    Cells(bFind.Row, Columns.Count).End(xlToLeft).Offset(0, -1).Value = TextBox5.Value
End If

Unload UserForm1

End Sub

Private Sub UserForm_Initialize()
For Each cell In Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)
    If cell.Value <> vbNullString Then ComboBox1.AddItem cell.Value
Next cell
End Sub

I'll now start on adding the option to add Items which are not found. I'll add in a message to ask for confirmation in case of a typo.

Best regards,
Trowa

TrowaD · Answer

Hi Leapout, Ok, great feedback. I think I added all functionality's, so give the code below a thorough test. added the option to add a new item, confirmation is asked in case of a typo. looking for the brand also checks type and origin. Here is the updated code: Private Sub CommandButton1_Click() Dim iFind, bFind As Range Dim fRow, lRow As Long, rDif, qMB As Integer Set iFind = Columns("A").Find(ComboBox1.Value) If iFind Is Nothing Then qMB = MsgBox("Would you like to add " & ComboBox1.Value & " as a new item?", vbYesNo) If qMB = vbNo Then Exit Sub fRow = Range("A" & Rows.Count).End(xlUp).Row lRow = Range("B" & Rows.Count).End(xlUp).Row rDif = lRow - fRow Rows(fRow & ":" & lRow).Copy Range("A" & lRow + 1).PasteSpecial Selection.SpecialCells(xlCellTypeConstants).ClearContents Range("A" & lRow + 1).Value = ComboBox1.Value Range("B" & lRow + 1 + rDif).Value = "TOTAL" If rDif > 2 Then For x = rDif To 2 Step -1 Rows(Range("B" & Rows.Count).End(xlUp).Row - 1).Delete Next x End If Cells(lRow + 1, "B").Value = TextBox1.Value Cells(lRow + 1, "C").Value = TextBox2.Value Cells(lRow + 1, "D").Value = TextBox3.Value fRow = lRow + 1 lRow = fRow + 1 Else fRow = iFind.Row If Range("B" & fRow).Value = vbNullString Then lRow = fRow Else lRow = iFind.End(xlDown).Row - 2 End If If lRow = 1048574 Then lRow = Range("B" & Rows.Count).End(xlUp).Row - 1 End If Set bFind = Range(Cells(fRow, "B"), Cells(lRow, "B")).Find(TextBox1.Value) If bFind Is Nothing Then GoTo nBTO If Range("C" & bFind.Row).Value = TextBox2.Value And Range("D" & bFind.Row).Value = TextBox3.Value Then Cells(bFind.Row, Columns.Count).End(xlToLeft).Offset(0, -2).Value = TextBox4.Value Cells(bFind.Row, Columns.Count).End(xlToLeft).Offset(0, -1).Value = TextBox5.Value Else nBTO: If Range("B" & lRow).Value <> vbNullString Then Rows(lRow).Copy Rows(lRow).Insert shift:=xlUp lRow = lRow + 1 Rows(lRow).SpecialCells(xlCellTypeConstants).ClearContents End If Cells(lRow, "B").Value = TextBox1.Value Cells(lRow, "C").Value = TextBox2.Value Cells(lRow, "D").Value = TextBox3.Value Cells(lRow, Columns.Count).End(xlToLeft).Offset(0, -2).Value = TextBox4.Value Cells(lRow, Columns.Count).End(xlToLeft).Offset(0, -1).Value = TextBox5.Value End If Unload UserForm1 End Sub Private Sub UserForm_Initialize() For Each cell In Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row) If cell.Value <> vbNullString Then ComboBox1.AddItem cell.Value Next cell End Sub Best regards, Trowa

TrowaD · Answer

Hi Leapout, Here it is, the latest version of the code: Private Sub CommandButton1_Click() Dim iFind, bFind As Range Dim fRow, lRow As Long, rDif, qMB As Integer Set iFind = Columns("A").Find(ComboBox1.Value) If iFind Is Nothing Then qMB = MsgBox("Would you like to add " & ComboBox1.Value & " as a new item?", vbYesNo) If qMB = vbNo Then Exit Sub fRow = Range("A" & Rows.Count).End(xlUp).Row lRow = Range("B" & Rows.Count).End(xlUp).Row rDif = lRow - fRow Rows(fRow & ":" & lRow).Copy Range("A" & lRow + 1).PasteSpecial Selection.SpecialCells(xlCellTypeConstants).ClearContents Range("A" & lRow + 1).Value = ComboBox1.Value Range("B" & lRow + 1 + rDif).Value = "TOTAL" If rDif > 2 Then For x = rDif To 2 Step -1 Rows(Range("B" & Rows.Count).End(xlUp).Row - 1).Delete Next x End If Cells(lRow + 1, "B").Value = TextBox1.Value Cells(lRow + 1, "C").Value = TextBox2.Value Cells(lRow + 1, "D").Value = TextBox3.Value fRow = lRow + 1 lRow = fRow + 1 Else fRow = iFind.Row If Range("B" & fRow).Value = vbNullString Then lRow = fRow Else lRow = iFind.End(xlDown).Row - 2 End If If lRow = 1048574 Then lRow = Range("B" & Rows.Count).End(xlUp).Row - 1 End If Set bFind = Range(Cells(fRow, "B"), Cells(lRow, "B")).Find(TextBox1.Value) If bFind Is Nothing Then GoTo nBTO firstAddress = bFind.Address Do If Range("C" & bFind.Row).Value <> TextBox2.Value Or Range("D" & bFind.Row).Value <> TextBox3.Value Then Set bFind = Range(Cells(fRow, "B"), Cells(lRow, "B")).FindNext(bFind) Else GoTo sBTO End If Loop While bFind.Address <> firstAddress nBTO: If Range("B" & lRow).Value <> vbNullString Then Rows(lRow).Copy Rows(lRow).Insert shift:=xlUp lRow = lRow + 1 Rows(lRow).SpecialCells(xlCellTypeConstants).ClearContents End If Cells(lRow, "B").Value = TextBox1.Value Cells(lRow, "C").Value = TextBox2.Value Cells(lRow, "D").Value = TextBox3.Value Cells(lRow, Columns.Count).End(xlToLeft).Offset(0, -2).Value = TextBox4.Value Cells(lRow, Columns.Count).End(xlToLeft).Offset(0, -1).Value = TextBox5.Value Unload UserForm1 Exit Sub sBTO: Cells(bFind.Row, Columns.Count).End(xlToLeft).Offset(0, -2).Value = TextBox4.Value Cells(bFind.Row, Columns.Count).End(xlToLeft).Offset(0, -1).Value = TextBox5.Value Unload UserForm1 End Sub I left out the Initialize part, as that is unchanged. Best regards, Trowa

Modified code copy data from userform to the empty last columns

6 responses

Similar discussions

Subscribe To Our Newsletter!