Copy Multiple Ranges with Criteria Match Paste into Another Sheet with appropriate ranges

[nandhavnk]

Hi,

I am beginner to vba code.

What I expecting in my code,

In Userform

Combo box = fetching Data Sheet values from Column A. This goes to next sheet range B2.

Delivery Name text box = fetching Data Sheet from Column D. This goes to next sheet range D2.

Date Text box = manually entering dates. This goes to next sheet range H2.

When Clicking Confirm button,

Checking in Data Sheet & coping combo box matched row values into next sheet from A3:L3. Here matched row titles will paste like item#1, Item#3, Item#4, etc. if items more than 10, show message box,

And matched rows Column B & C values in Order Form Sheet range A4 & B4, pasting rest values in respective item columns and remove blank cells.

Eg.

Date Sheet Values Sample,

Copy with Criteria & Paste.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP	AQ	AR	AS	AT	AU	AV	AW	AX	AY
1
2
3
4	Order No	Date	Time	Name	Item#1	Item#2	Item#3	Item#4	Item#5	Item#6	Item#7	Item#8	Item#9	Item#10	Item#11	Item#12	Item#13	Item#14	Item#15	Item#16	Item#17	Item#18	Item#19	Item#20	Item#21	Item#22	Item#23	Item#24	Item#25	Item#26	Item#27	Item#28	Item#29	Item#30	Item#31	Item#32	Item#33	Item#34	Item#35	Item#36	Item#37	Item#38	Item#39	Item#40	Item#41	Item#42	Item#43	Item#44	Item#45	Item#46
5	1	04-Aug-22	10:36 AM	Sivakumar	55.00						55.00										55.00									55.00	55.00			55.00														55.00			7
6	5	06-Aug-22	2:00 PM	Ramkumar				55.00		55.00	55.00	55.00		55.00				55.00						55.00																											7
7	3	15-Aug-22	1:55 PM	Vimal	55.00																							55.00	55.00	55.00			55.00	55.00		55.00															7
8	4	25-Aug-22	6:15 PM	Mohankumar		55.00				55.00		55.00										55.00									55.00																55.00		55.00		7
9	5	30-Aug-22	9:25 AM	Ramkumar		55.00							55.00	55.00				55.00		55.00			55.00		55.00																										7
10	4	04-Sep-22	8:56 PM	Mohankumar			55.00				55.00										55.00		55.00			55.00																						55.00		55.00	7
11	3	06-Sep-22	2:44 PM	Vimal				55.00		55.00	55.00	55.00		55.00													55.00		55.00																						7
12	6	15-Sep-22	3:25 PM	Murugan	55.00												55.00				55.00												55.00			55.00			55.00				55.00								7
13	3	25-Sep-22	4:35 PM	Vimal		55.00		55.00	55.00						55.00			55.00							55.00																	55.00									7
14	4	04-Oct-22	12:12 PM	Mohankumar						55.00		55.00	55.00			55.00				55.00		55.00	55.00																												7
15	3	09-Oct-22	4:28 AM	Vimal			55.00				55.00			55.00			55.00				55.00			55.00																						55.00					7
16	7	14-Oct-22	5:55 AM	Savitha		55.00												55.00				55.00					55.00		55.00								55.00							55.00							7
Data

Cell Formulas
Range	Formula
AY5:AY16	AY5	=COUNT(E5:AX5)

Userform

Order Form Sheet Format Sample

Copy with Criteria & Paste.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1
2	Order No :		Name :				Date :
3	Date	Time
4
5
6
7
8
9
10
11
12
13
14	Total
15
Order Form

Cell Formulas
Range	Formula
C14:N14	C14	=IF(ISBLANK(C4:C13)="",SUM(C4:C13),"")

Expected Output in Order Form Sheet,

Copy with Criteria & Paste.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1
2	Order No :	0005	Name :	Ramkumar			Date :	17-Oct-22
3	Date	Time	Item#2	Item#4	Item#6	Item#7	Item#8	Item#9	Item#10	Item#14	Item#16	Item#19	Item#20	Item#21
4	06-Aug-22	2:00 PM		55.00	55.00	55.00	55.00		55.00	55.00			55.00
5	30-Aug-22	9:25 AM	55.00					55.00	55.00	55.00	55.00	55.00		55.00
6
7
8
9
10
11
12
13
14	Total		55.00	55.00	55.00	55.00	55.00	55.00	110.00	110.00	55.00	55.00	55.00	55.00
15
Order Form

Cell Formulas
Range	Formula
C14:N14	C14	=IF(ISBLANK(C4:C13)=TRUE,"",SUM(C4:C13))

My code is,

Private Sub cmdconfirmO_Click()
Dim ecol As Long, erow As Long, lastrow As Long, i As Long, lastcol As Long

lastrow = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).row
lastcol = Worksheets("Data").Cells(4, Columns.Count).End(xlToLeft).Column
For i = 4 To lastrow
 For j = 2 To lastcol
    Worksheets("Order Form").Cells(2, 2).Value = Format(Me.cbordnO.Text, "0000")
    Worksheets("Order Form").Cells(2, 4).Value = Me.txtdelO.Value
    Worksheets("Order Form").Cells(2, 8).Value = Me.txtdateO.Value
    If Worksheets("Data").Cells(i + 1, 1).Value = Me.cbordnO.Text Then
     If Worksheets("Data").Cells(i, j) <> "" Then
        Worksheets("Data").Range(Cells(i, j), Cells(i, j)).Copy
        Worksheets("Order Form").Activate
        erow = Worksheets("Order Form").Cells(Rows.Count, 1).End(xlUp).row
        ecol = Worksheets("Order Form").Cells(3, Columns.Count).End(xlToLeft).Offset(0, 1).Column
        Worksheets("Order Form").Cells(3, ecol).Select
        ActiveSheet.Paste Destination:=Worksheets("Order Form").Range(Cells(erow, ecol), Cells(erow, ecol))
        Sheets("Data").Activate
     End If
    End If
 Next j
Next i
Application.CutCopyMode = False
Me.cbordnO.Value = ""
Me.txtdateO.Value = ""
Me.Hide
End Sub

I know this code is not correct. But I dont know how to rectify this issue.

I invite experts look my sheet and give me a solution or a idea. I am stuck here so long.

Thanks

 

[DanteAmor]

I put ALL the code for your Userform.
If you want only 10 columns, change ncol to the number 12 on this line.

.Range("A3").Resize(nRow, nCol).Value = c

Put all the code in your userform, replace your existing code.

Private Sub cbordnO_Change()
  Dim f As Range

  txtdelO.Value = ""
  txtdateO.Value = ""
 
  If cbordnO.ListIndex > -1 Then
    Set f = Sheets("Data").Range("A:A").Find(CDbl(cbordnO.Value), , xlValues, xlWhole)
    If Not f Is Nothing Then
      txtdelO.Value = Sheets("Data").Range("D" & f.Row).Value
    End If
  End If
End Sub

Private Sub cmdconfirmO_Click()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, nRow As Long, nCol As Long
  Dim have_data As Boolean
  Dim tot As Double
 
  'Validations
  If cbordnO.Value = "" Or txtdelO.Value = "" Or txtdateO.Value = "" Then
    MsgBox "complete the data"
    Exit Sub
  End If
 
  a = Sheets("Data").Range("A4:AX" & Sheets("Data").Range("A" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
 
  nRow = 2
  c(1, 1) = "Date"
  c(1, 2) = "Time"
  For i = 2 To UBound(a, 1)
    If a(i, 1) = CDbl(cbordnO.Value) Then
      have_data = False
       
      For j = 5 To UBound(a, 2) - 1
       
        If a(i, j) <> "" Then
          have_data = True
          b(1, j - 2) = a(1, j)
          b(nRow, 1) = a(i, 2)
          b(nRow, 2) = a(i, 3)
          b(nRow, j - 2) = a(i, j)
         
          c(nRow, 1) = a(i, 2)
          c(nRow, 2) = a(i, 3)
        End If
     
      Next
      If have_data Then
        nRow = nRow + 1
      End If
    End If
  Next
 
  nCol = 3
  For j = 3 To UBound(b, 2)
    tot = 0
    If b(1, j) <> "" Then
      c(1, nCol) = b(1, j)
      For i = 2 To UBound(b, 1)
        c(i, nCol) = b(i, j)
        tot = tot + b(i, j)
      Next
      c(nRow, nCol) = tot
      nCol = nCol + 1
    End If
  Next
 
  With Sheets("Order Form")
    .Range("A4", .Cells(Rows.Count, Columns.Count)).ClearContents
    .Range("C3", .Cells(3, Columns.Count)).ClearContents
 
    .Range("B2").Value = cbordnO.Value
    .Range("D2").Value = txtdelO.Value
    .Range("H2").Value = txtdateO.Value
   
    .Range("A3").Resize(nRow, nCol).Value = c
  End With
  Unload Me
End Sub

Private Sub UserForm_Activate()
  Dim dic As Object
  Dim i As Long
 
  Set dic = CreateObject("Scripting.Dictionary")
  With Sheets("Data")
    For i = 5 To .Range("A" & Rows.Count).End(3).Row
      dic(.Range("A" & i).Value) = Empty
    Next
  End With
  cbordnO.List = dic.keys
End Sub

 

[nandhavnk]

Hi Mr.DanteAmor,

Thank you so much kindness. I very thankful to you.

The code is working properly.

Here I have 3 questions,
1. I expecting Sum values in Row14(fixed).
2. In combo box, how to arrange numbers in ascending.
3. after selection Order No.4 in combo box and click confirm button. That last value ie Item#46, 55.00 not shown.
Here images

Copy with Criteria & Paste.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
1
2	Order No :	0004	Name :	Mohankumar			Date :	18-Oct-22
3	Date	Time	Item#2	Item#3	Item#6	Item#7	Item#8	Item#9	Item#12	Item#16	Item#17	Item#18	Item#19	Item#22	Item#27	Item#43	Item#44	Item#45
4	25-Aug-22	6:15 PM	55.00		55.00		55.00					55.00			55.00	55.00		55.00
5	04-Sep-22	8:56 PM		55.00		55.00					55.00		55.00	55.00			55.00
6	04-Oct-22	12:12 PM			55.00		55.00	55.00	55.00	55.00		55.00	55.00
7			55.00	55.00	110.00	55.00	110.00	55.00	55.00	55.00	55.00	110.00	110.00	55.00	55.00	55.00	55.00	55.00
8
9
10
11
12
13
14
Order Form

Actually output expect is,

Copy with Criteria & Paste.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1
2	Order No :	0004	Name :	Mohankumar			Date :	18-Oct-22
3	Date	Time	Item#2	Item#3	Item#6	Item#7	Item#8	Item#9	Item#12	Item#16	Item#17	Item#18	Item#19	Item#22	Item#27	Item#43	Item#44	Item#45	Item#46
4	25-Aug-22	6:15 PM	55.00		55.00		55.00					55.00			55.00	55.00		55.00
5	04-Sep-22	8:56 PM		55.00		55.00					55.00		55.00	55.00			55.00		55.00
6	04-Oct-22	12:12 PM			55.00		55.00	55.00	55.00	55.00		55.00	55.00
7
8
9
10
11
12
13
14			55.00	55.00	110.00	55.00	110.00	55.00	55.00	55.00	55.00	110.00	110.00	55.00	55.00	55.00	55.00	55.00	55.00
Order Form

Thanks in advance

 

[DanteAmor]

1. I expecting Sum values in Row14(fixed).

remove these lines from the macro
c(nRow, nCol) = tot
.Range("A4", .Cells(Rows.Count, Columns.Count)).ClearContents
.Range("C3", .Cells(3, Columns.Count)).ClearContents

2. In combo box, how to arrange numbers in ascending.

Sort the numbers in another column and load those numbers or sort your data by number.

3. after selection Order No.4 in combo box and click confirm button. That last value ie Item#46, 55.00 not shown.

Change this line:
For j = 5 To UBound(a, 2) - 1

For this:
For j = 5 To UBound(a, 2)

 

[nandhavnk]

Its working perfectly. Thank you!!!

I have one more clarification,
If i have add UOM below item Numbers, this worksheet forumat vlookup. Here Example,

Copy with Criteria & Paste.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA
1
2	Order No :	0003	Name :	Vimal			Date :	18-Oct-22
3	Date	Time	Item#1	Item#2	Item#3	Item#4	Item#5	Item#6	Item#7	Item#8	Item#10	Item#11	Item#13	Item#14	Item#17	Item#20	Item#21	Item#23	Item#24	Item#25	Item#26	Item#29	Item#30	Item#32	Item#38	Item#42
4			UOM1	UOM2	UOM3	UOM4	UOM5	UOM6	UOM7	UOM8	UOM9	UOM10	UOM11	UOM12	UOM13	UOM14	UOM15	UOM16	UOM17	<==== This is Default row with vlookup function based item type.
5	15-Aug-22	1:55 PM	55.00																55.00	55.00	55.00	55.00	55.00	55.00
6	06-Sep-22	2:44 PM				55.00		55.00	55.00	55.00	55.00							55.00		55.00
7	25-Sep-22	4:35 PM		55.00		55.00	55.00					55.00		55.00			55.00								55.00
8	09-Oct-22	4:28 AM			55.00				55.00		55.00		55.00		55.00	55.00										55.00
9
10
11
12
13
14			55.00	55.00	55.00	110.00	55.00	55.00	110.00	55.00	110.00	55.00	55.00	55.00	55.00	55.00	55.00	55.00	55.00
Order Form

Is this possible, Kindly clarify this.

Thanks