Capture 496 Fields To Datafile ???

[Logit]

.
Is it possible to capture 496 data fields to a sheet row, using the below syntax ? Another way of saying this is : 'writing' data from 496 form fields to a table consisting of 494 columns.

Sub EnterData()
    Dim wsData As Worksheet
    Dim wsForm As Worksheet
    Set wsData = Sheets("Database")
    Set wsForm = Sheets("FSA")
    Dim NewRow As Long
    Application.ScreenUpdating = False
    NewRow = Application.WorksheetFunction.CountA(wsData.Range("A:A")) + 1
    
    'The next two lines can be expanded as many times as needed for all the entry fields in your project
    'General Information Section :
    wsData.Cells(NewRow, 1).Value = wsForm.Range("J1").Value
    wsData.Cells(NewRow, 2).Value = wsForm.Range("E2").Value
    wsData.Cells(NewRow, 3).Value = wsForm.Range("J2").Value
    wsData.Cells(NewRow, 4).Value = wsForm.Range("J3").Value
    wsData.Cells(NewRow, 5).Value = wsForm.Range("J6").Value
    wsData.Cells(NewRow, 6).Value = wsForm.Range("J7").Value
    wsData.Cells(NewRow, 7).Value = wsForm.Range("J8").Value
    'Administrative Section :
    wsData.Cells(NewRow, 8).Value = wsForm.Range("D12").Value
    wsData.Cells(NewRow, 9).Value = wsForm.Range("E12").Value
    wsData.Cells(NewRow, 10).Value = wsForm.Range("F12").Value
    wsData.Cells(NewRow, 11).Value = wsForm.Range("G12").Value
    wsData.Cells(NewRow, 12).Value = wsForm.Range("D13").Value
    wsData.Cells(NewRow, 13).Value = wsForm.Range("E13").Value
    wsData.Cells(NewRow, 14).Value = wsForm.Range("F13").Value
    wsData.Cells(NewRow, 15).Value = wsForm.Range("G13").Value
    wsData.Cells(NewRow, 16).Value = wsForm.Range("D14").Value
    wsData.Cells(NewRow, 17).Value = wsForm.Range("E14").Value
    wsData.Cells(NewRow, 18).Value = wsForm.Range("F14").Value
    wsData.Cells(NewRow, 19).Value = wsForm.Range("G14").Value
    wsData.Cells(NewRow, 20).Value = wsForm.Range("D15").Value
    wsData.Cells(NewRow, 21).Value = wsForm.Range("E15").Value
    wsData.Cells(NewRow, 22).Value = wsForm.Range("F15").Value
    wsData.Cells(NewRow, 23).Value = wsForm.Range("G15").Value
    wsData.Cells(NewRow, 24).Value = wsForm.Range("D16").Value
    wsData.Cells(NewRow, 25).Value = wsForm.Range("E16").Value
    wsData.Cells(NewRow, 26).Value = wsForm.Range("F16").Value
    wsData.Cells(NewRow, 27).Value = wsForm.Range("G16").Value

'additional data fields follow below ...

Application.ScreenUpdating = True
End Sub

If there is ... how do I edit the above ?

Or .. what other approach should I be using ?

Thank you !

[Roel Jongman]

I see a lot of sequential columns being copied, this method is a lot of needless code then.. it is fine for copying 3 or 4 non sequential columns but for long ranges of columns there are better methods.
below the code should do exactly the same

Sub EnterData()
    Dim wsData As Worksheet
    Dim wsForm As Worksheet
    Set wsData = Sheets("Database")
    Set wsForm = Sheets("FSA")
    Dim NewRow As Long
    Application.ScreenUpdating = False
    NewRow = Application.WorksheetFunction.CountA(wsData.Range("A:A")) + 1
    
    'The next two lines can be expanded as many times as needed for all the entry fields in your project
    'General Information Section :
    wsData.Cells(NewRow, 1).Value = wsForm.Range("J1").Value
    wsData.Cells(NewRow, 2).Resize(1, 6).Copy
        wsForm.Range("E2").PasteSpecial xlPasteValues
    
    'Administrative Section :
    wsData.Cells(NewRow, 8).Resize(1, 20).Copy
        wsForm.Range("D12").PasteSpecial xlPasteValues
        
    
'additional data fields follow below ...

Application.ScreenUpdating = True
End Sub

So to sum it up what you can do is put the first cell or a range of columns in VBA. then use resize to expand the range. where, 1 is for keeping the copy range at 1 row and the 6 is to have 6 columns total including the cell you stated as startcell.
the method you used for copying works as a paste of values so that is why I used .pastespecial xlPastevalues on the codeline for the destination of the range. You only need to point to the first cell of the range you want to paste in
Everytime you want to skip one or more columns you can start a new set of copy, paste lines for the next sequential section

[Logit]

Trying to post additional information. Please stand by.

[Logit]

.

File provided ... other post.

[Logit]

.
File provided below - other post ...

[Fluff13]

This section

    'Administrative Section :
    wsData.Cells(NewRow, 8).Value = wsForm.Range("D12").Value
    wsData.Cells(NewRow, 9).Value = wsForm.Range("E12").Value
    wsData.Cells(NewRow, 10).Value = wsForm.Range("F12").Value
    wsData.Cells(NewRow, 11).Value = wsForm.Range("G12").Value

could be re-written as

    'Administrative Section :
    wsData.Cells(NewRow, 8).resize(,4).Value = wsForm.Range("D12:G12").Value

Which you could then loop like

x = 11
For i = 8 To 496 Step 4
   x = x + 1
   wsData.Cells(NewRow, i).Resize(, 4).Value = wsForm.Range("D" & x).Resize(, 4).Value
Next i

[Roel Jongman]

Wel now I have to strain my mind to get what you mean.. and that is not gonna work off screenshots.
I see now that my code for administration section will not work properly as the data is set up a little different then I first read / interpreted.

so here come the most spoken words on excelforum.com:

please provide an example file (excel workbook! not a picture) desenzitised but still a good representation of the original file. Also show an "after sheet of how the data will look.
All I was able to do of you code was to compromize the cell by cell copy to a section by section copy. But if you need top copy close to 500 cell over 20 or more sections then we need a file to help you.
And otherwise it will have to put a lot of elbow grease for you to put in the 500 lines of wsdata = wsform..

[Logit]

.
See attached and thank you for your assistance.

As you will see, some of the sections vary is size from the others, although they all pretty much do the same thing (4 columns of data).
Data from FSA sheet saved to Database sheet.

[jindon]

One way

    Dim e, t As Long
    t = 1
    For Each e In Split("J1,E2,J2,J3,J6,J7,J8,D12:G12,D13:G13,D14:G14,D15:G15,D16:G16", ",")
        With Range(e)
            wsData.Cells(NewRow, t).Resize(, .Columns.Count).Value = wsForm.Range(e).Value
            t = t + .Columns.Count
        End With
    Next

[Logit]

.
Thank you for your response Jindon ...

Let me try to dissect this macro ...

"e" is the cell
"t" is Col A

I presume (???) 'For Each e In Split' cannot contain 496 cell references ? If this is correct, how would I edit
the macro so the remainder of the cells data would all be 'written / copied' to the Database sheet ?

For Each e In Split("J1,E2,J2,J3,J6,J7,J8,D12:G12,D13:G13,D14:G14,D15:G15,D16:G16", ",")

[jindon]

1) e is a variable. Each element of array created by Split function.
2) Doesn't matter of the length.
So you write the long text like below with the line break.

For Each e In Split("1,2,3,4,5,6,7,8,9," & _
                            "10,11,12,13,14,15," & _
                            "16,17,18,19,20",",")

[Logit]

.
This will be acceptable ?:

For Each e In Split("J1,E2,J2,J3,J6,J7,J8,D12:G12,D13:G13,D14:G14,D15:G15,D16:G16, D19:G19, D20:G20," & _
 D21:G21, D22:G21, D22:G22, etc., etc., etc. etc., J19:M19, J20:M20, J21:M21, J22:M22, etc., etc., etc., J99:M99, J100:M100, J101:M101, etc., etc., etc.,", ",")

[jindon]

Absolutely. However you are missing double quote at the beginning of 2nd line.

For Each e In Split("J1,E2,J2,J3,J6,J7,J8,D12:G12,D13:G13,D14:G14,D15:G15,D16:G16, D19:G19, D20:G20," & _
 "D21:G21, D22:G21, D22:G22, etc., etc., etc. etc., J19:M19, J20:M20, J21:M21, J22:M22, etc., etc., etc., J99:M99, J100:M100, J101:M101, etc., etc., etc.,", ",")

[Logit]

.
Excellent.

Let me dive into this and see what happens.

Thank you sir !

[Roel Jongman]

So I read the above solution, but I thought it must be possible to improve on it, to avoid having to stick 100 ranges or so in 1 array by hand.
The form is well structured, each section has 5 column that translate in the database to 4 data sets to be written to the database first column is in row 2 of the database
There are some minor snags like the empty lines at row 65 breaking the patern a bit for loops, but I worked thru it. and I came up with the code below

Sub UploadForm()
'variables for sheethandling
Dim wsData, wsForm As Worksheet
Set wsData = Sheets("Database")
Set wsForm = Sheets("FSA")

'varibles for loops
Dim strtIns, lpC, lpI As Integer
Dim rwC, rwI
strtIns = 8

'arrays with startrows of each section in Column C and column I
Dim arrColCrw()
Dim arrColIrw()
arrColCrw = Array(12, 19, 25, 30, 42, 51, 59, 68, 78, 86, 94, 102)
arrColIrw = Array(19, 32, 40, 48, 54, 60, 68, 76, 82, 93, 99)

'find first free row in database
Dim NewRow As Long
NewRow = Application.WorksheetFunction.CountA(wsData.Range("A:A")) + 1

'load General section to database
wsData.Cells(NewRow, 1).Value = wsForm.Range("J1").Value
wsData.Cells(NewRow, 2).Value = wsForm.Range("E2").Value
wsData.Cells(NewRow, 3).Value = wsForm.Range("J2").Value
wsData.Cells(NewRow, 4).Value = wsForm.Range("J3").Value
wsData.Cells(NewRow, 5).Value = wsForm.Range("J6").Value
wsData.Cells(NewRow, 6).Value = wsForm.Range("J7").Value
wsData.Cells(NewRow, 7).Value = wsForm.Range("J8").Value

'fill database by Looping thru Column C sections using arrColCrw for the startrow of each section
For Each rwC In arrColCrw
    For lpC = rwC To wsForm.Cells(rwC, 3).End(xlDown).Row - IIf(rwC = 59 Or rwC = 102, 0, 1)
        wsData.Cells(NewRow, strtIns).Resize(1, 4).Value = wsForm.Cells(lpC, 4).Resize(1, 4).Value
        strtIns = strtIns + 4
    Next lpC
Next rwC

'fill database by Looping thru Column I sections using arrColIrw for the startrow of each section
For Each rwI In arrColIrw
    For lpI = rwI To wsForm.Cells(rwI, 9).End(xlDown).Row - IIf(rwI = 60 Or rwI = 99, 0, 1)
        wsData.Cells(NewRow, strtIns).Resize(1, 4).Value = wsForm.Cells(lpI, 10).Resize(1, 4).Value
        strtIns = strtIns + 4
    Next lpI
Next rwI

End Sub

So the general information is unchanged. 7 fields scatterd over 15 columns and 8 rows did not even bother to find a loop for it.
But after that there are 2 destinct columns C and I that form the start col of all sections. and each section has a variable amount of rows. So I decided to create a simple array for col C and Col I with nothing more than the startrow of the first question of that section. (see arrColCrw and arrColIrw)

so lets breakdown the for each loop for colC

For Each rwC In arrColCrw
rwC holds 1 value at a time of the arrColCrw,
then we need to determine how many rows this section has or better at which row to start this is determined by For lpC = rwC To
and at which row to end looping thru the sectionrows wsForm.Cells(rwC, 3).End(xlDown).Row
Because the sections are without blankrows between them xldown needs an adjustment biy -1 rows and because there are also two sections that do have a blank row just below them 2 exceptions to the -1 rule have to be made, so that resulted in - IIf(rwC = 59 Or rwC = 102, 0, 1)

Then all we need is a simple copy paste statement to get the values into the database
wsData.Cells(NewRow, strtIns).Resize(1, 4).Value = wsForm.Cells(lpC, 4).Resize(1, 4).Value
where NewRow is the first blankrow in the database, that stays the same for the whole code.
strtIns = the startpoint of the insert that moves 4 cells left after pasting the values of 1 row. the very first insert point is set to 8 at the declaration an initializing section at the top of the code column 8 is the first insert point because general information is 7 columns.
the .resize is to change both copy and paste range from 1 col to 4 columns (1 row high)
lpC is the value that holds the current row of the form being copied
the laststatement of the loop strtIns = strtIns + 4 makes sure that the insert point is moved right by 4 columns

I really enjoyed getting this all in 2 loops instead of making an array with close to 100 ranges to copy. It was for me a great excercise in translating a repetative paterns into vba code.

I hope the solution works for you and you can also see the logic of it.
See also the attachement, in Module2 there is my code. In module 3 I did some testcode I kept it in to look at just to see what i tried

[Logit]

.
Jindon and all :

I am receiving an error as listed in the macro below :

Option Explicit

Sub EnterData()

Dim e, t As Long
Dim wsData As Worksheet
Dim wsForm As Worksheet
Dim NewRow As Long

    Set wsData = Sheets("Database")
    Set wsForm = Sheets("FSA")
    
    Application.ScreenUpdating = False
    
    t = 1
    
    For Each e In Split("J1,E2,J2,J3,J6,J7,J8,D12:G12,D13:G13,D14:G14,D15:G15,D16:G16,D19:G19, D20:G20, D21:G21, D22:G22," & _
                        "D25:G25, D26:G26, D27:G27, D30:G30, D31:G31, D32:G32, D33:G33, D34:G34, D35:G35, D36:G36, D37:G37," & _
                        "D38:G38, D39:G39, D42:G42, D43:G43, D44:G44, D45:G45, D46:G46, D47:G47,D48:G48, D51:G51, D52:G52," & _
                        "D53:G53,D54:G54, D55:G55, D56:G56, D59:G59, D60:G60, D61:G61, D62:G62, D63:G63, D64:G64, D68:G68," & _
                        "D69:G69, D70:G70, D71:G71, D72:G72, D73:G73, D74:G74, D75:G75, D78:G78, D79:G79, D80:G80, D81:G81," & _
                        "D82:G82, D83:G83, D86:G86, D87:G87, D88:G88, D89:G89, D90:G90, D91:G91, D94:G94, D95:G95 D96:G96," & _
                        "D97:G97, D98:G98, D99:G99, D102:G102, D103:G103, D104:G104", ",")
        With Range(e)
            wsData.Cells(NewRow, t).Resize(, .Columns.Count).Value = wsForm.Range(e).Value '<-- error here Run Time Errr 1004
            t = t + .Columns.Count                                                         'Application Defined or Object Defined error
        End With
    Next
Application.ScreenUpdating = False

End Sub

Attempted to Dim "Columns" / "Range" with no success. Not certain what needs to be defined at this point. ???

[Logit]

.
Roel:

Thank you for your input. The macro works very well.

I follow most of the logic but admittedly not all. I'll need to study it a lot more.

Kudos to you sir !


Cheers !!!!!

[Fluff13]

Your "NewRow" variable doesn't have a value

[Logit]

.
Overlooked .. thanks Fluff13.

New error as indicated. ???

Sub EnterData()

Dim e, t As Long
Dim wsData As Worksheet
Dim wsForm As Worksheet
Dim NewRow As Long

    Set wsData = Sheets("Database")
    Set wsForm = Sheets("FSA")
    
    Application.ScreenUpdating = False
    
    NewRow = Application.WorksheetFunction.CountA(wsData.Range("A:A")) + 1

    t = 1
    
    For Each e In Split("J1,E2,J2,J3,J6,J7,J8,D12:G12,D13:G13,D14:G14,D15:G15,D16:G16,D19:G19, D20:G20, D21:G21, D22:G22," & _
                        "D25:G25, D26:G26, D27:G27, D30:G30, D31:G31, D32:G32, D33:G33, D34:G34, D35:G35, D36:G36, D37:G37," & _
                        "D38:G38, D39:G39, D42:G42, D43:G43, D44:G44, D45:G45, D46:G46, D47:G47,D48:G48, D51:G51, D52:G52," & _
                        "D53:G53,D54:G54, D55:G55, D56:G56, D59:G59, D60:G60, D61:G61, D62:G62, D63:G63, D64:G64, D68:G68," & _
                        "D69:G69, D70:G70, D71:G71, D72:G72, D73:G73, D74:G74, D75:G75, D78:G78, D79:G79, D80:G80, D81:G81," & _
                        "D82:G82, D83:G83, D86:G86, D87:G87, D88:G88, D89:G89, D90:G90, D91:G91, D94:G94, D95:G95 D96:G96," & _
                        "D97:G97, D98:G98, D99:G99, D102:G102, D103:G103, D104:G104", ",")
                        
                        '<-- error here Run Time Error 1004
        With Range(e)   '<-- Method Range of Object_Global Failed

            wsData.Cells(NewRow, t).Resize(, .Columns.Count).Value = wsForm.Range(e).Value
            t = t + .Columns.Count
        End With
    Next
Application.ScreenUpdating = False

End Sub

[Fluff13]

You're missing a comma on the penultimate line of the array

                        "D82:G82, D83:G83, D86:G86, D87:G87, D88:G88, D89:G89, D90:G90, D91:G91, D94:G94, D95:G95, D96:G96," & _

[Roel Jongman]

it needs to know on what sheet to look so in this case wsform.Range(e)

[Logit]

.
Wonderful ! With both comments it is working !!!

Now to finish the remainder of form input. Will let you know how it ends.

Thank you !

[Fluff13]

You're welcome & thanks for the feedback

[Logit]

.
New challenge.

The macro is "writing" data up to cells J36:M36. It won't go any further.

Is there a limit how many ranges this macro is "write" or have I created another syntax error ? I checked it several times ... seems to be correct.

Sub EnterData()

Dim e, t As Long
Dim wsData As Worksheet
Dim wsForm As Worksheet
Dim NewRow As Long

    Set wsData = Sheets("Database")
    Set wsForm = Sheets("FSA")
    
    Application.ScreenUpdating = False
    
    NewRow = Application.WorksheetFunction.CountA(wsData.Range("A:A")) + 1

    t = 1
    
    For Each e In Split("J1,E2,J2,J3,J6,J7,J8,D12:G12,D13:G13,D14:G14,D15:G15,D16:G16,D19:G19, D20:G20, D21:G21, D22:G22," & _
                        "D25:G25, D26:G26, D27:G27, D30:G30, D31:G31, D32:G32, D33:G33, D34:G34, D35:G35, D36:G36, D37:G37," & _
                        "D38:G38, D39:G39, D42:G42, D43:G43, D44:G44, D45:G45, D46:G46, D47:G47, D48:G48, D51:G51, D52:G52," & _
                        "D53:G53, D54:G54, D55:G55, D56:G56, D59:G59, D60:G60, D61:G61, D62:G62, D63:G63, D64:G64, D68:G68," & _
                        "D69:G69, D70:G70, D71:G71, D72:G72, D73:G73, D74:G74, D75:G75, D78:G78, D79:G79, D80:G80, D81:G81," & _
                        "D82:G82, D83:G83, D86:G86, D87:G87, D88:G88, D89:G89, D90:G90, D91:G91, D94:G94, D95:G95, D96:G96," & _
                        "D97:G97, D98:G98, D99:G99, D102:G102, D103:G103, D104:G104, J19:M19, J20:M20, J21:M21, J22:M22," & _
                        "J23:M23, J24:M24, J25:M25, J26:M26, J27:M27, J28:M28, J29:M29, J33:M33, J34:M34, J35:M35, J36:M36," & _
                        "J37:M37", ",")  '<-- won't go beyond J36:M36
                        
                        '<-- error here Run Time Error 1004
        With wsForm.Range(e)   '<-- Method Range of Object_Global Failed
            wsData.Cells(NewRow, t).Resize(, .Columns.Count).Value = wsForm.Range(e).Value
            t = t + .Columns.Count
        End With
    Next
    
    Application.ScreenUpdating = False

End Sub

[Logit]

.
Thank you to all for your assistance. It works as desired.

I'll move on to the next stage and post my queries in another POST.

Again, thank you.

[Logit]

.
Disregard .... I found the error. The ranges are mis-numbered.

I should have started with J32:M32 .

My apologies ...