Forum

Excel VBA - copy da...
 
Notifications
Clear all

Excel VBA - copy data to multiple lines

3 Posts
2 Users
0 Reactions
121 Views
(@confused-com)
Posts: 13
Eminent Member
Topic starter
 

Hi all.  I've got a spreadsheet where users enter data via a form, which when they hit the SUBMIT button, copies some of the data (let's call it ClientSummaryData) to a DATA worksheet.  I have the macro all up and working for this.

However, I also need the macro to copy some of that same ClientSummaryData as well as details from the "Order Details" part of the Form to a different worksheet, called Order Details, but can't work out how to do it, as although the Client Data appears once, the order may contain many lines.

What I'm trying to explain (badly, sorry!) is that I need the form to populate the Order Details sheet with a line for EACH item under Order Details, whilst duplicating things like Family Surname and EHM number.  I've attached a copy of my spreadsheet so you can see what I mean, but do please feel free to ask any questions.

I really appreciate your help with this, and please don't judge my existing VBA - I'm still learning!!

Many thanks.

Tracey Smile

Sorry there are two copies - I couldn't work out how to delete the first one - please refer to the 44kb one.

 
Posted : 12/01/2024 3:16 pm
(@confused-com)
Posts: 13
Eminent Member
Topic starter
 

Oh dear - almost 24 hours, 40+ views and no replies - what have I done wrong?!

In the meantime, I've been working on it, and have managed to start to populate the Order Details worksheet, but I just can't work out how to get it to copy the multiple Order Detail lines - can anyone help, please?

I've attached an updated copy with the progress I've made so far.

 
Posted : 13/01/2024 1:09 pm
(@debaser)
Posts: 836
Member Moderator
 

Try something like this:

Sub data()
Dim ws_Form As Worksheet
Set ws_Form = Sheets("Form")
Dim ws_Data As Worksheet
Set ws_Data = Sheets("Data")
Dim dataRangeNames()
dataRangeNames = Array("Family_Surname", "postcode", "EHM_Check", "Name", "Job_Title", "Date", _
"Q_Socks", "Q_Tights", "Q_Hats", "Q_Gloves", "Q_Scarf", "Q_Blanket", _
"Q_Pyjamas", "Q_Wellies", "Q_Coat", "Q_Duvet", "Q_Other", "Q_Total", _
"C_Socks", "C_Tights", "C_Hats", "C_Gloves", "C_Scarf", "C_Blanket", _
"C_Pyjamas", "C_Wellies", "C_Coat", "C_Duvet", "C_Other", "C_Total", _
"No.Children", "No.Pensioners", "No.Disabled", "Reduce_Stress", _
"Improve_Wellbeing", "Improve_Mental_Health", "Free_Up_Money")

next_row = ws_Data.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
Dim col As Long
col = 1
Dim nm
For Each nm In dataRangeNames
ws_Data.Cells(next_row, col).Value = ws_Form.Range(nm).Value
col = col + 1
Next nm

Dim ws_Orders As Worksheet
Set ws_Orders = Sheets("Order Details")

next_row = ws_Orders.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
Dim numOrderRows As Long
numOrderRows = Application.CountA(Range("A35:A49"))
With ws_Orders
.Cells(next_row, "A").Resize(numOrderRows, 6).Value = Array(ws_Form.Range("EHM_Check").Value, ws_Form.Range("Date").Value, ws_Form.Range("Name").Value, _
ws_Form.Range("District").Value, ws_Form.Range("Family_Surname").Value, ws_Form.Range("Postcode").Value)
.Cells(next_row, "Q").Resize(numOrderRows).Value = ws_Form.Range("Delivery").Value
Dim n As Long
For n = 1 To numOrderRows
.Cells(next_row, "G").Resize(1, 10).Value = ws_Form.Range("A35").Offset(n - 1).Resize(1, 10).Value
next_row = next_row + 1
Next n
End With
With ws_Form
.Range("Family_Surname").Value = ""
.Range("postcode").Value = ""
.Range("EHM_Check").Value = ""
.Range("Name").Value = ""
.Range("District").Value = ""
.Range("Job_Title").Value = ""
.Range("Date").Value = ""
.Range("No.Children").Value = ""
.Range("No.Pensioners").Value = ""
.Range("No.Disabled").Value = ""
.Range("No.People").Value = ""
.Range("Delivery").Value = ""
.Range("Reduce_Stress").Value = ""
.Range("Improve_Wellbeing").Value = ""
.Range("Improve_Mental_Health").Value = ""
.Range("Free_Up_Money").Value = ""
End With

OutPut = MsgBox("Thank you for your submission", vbOKOnly, "Submission complete")

End Sub

 
Posted : 16/01/2024 7:49 am
Share: