I have realized that I go through a cycle of writing basic macros every so often at work. I have pieced together some more advanced over the years but have since forgotten them.
I have a basic form that I want to automate into a sheet that can be used to input data into an access database. Due to the nature of the information on the form, I can not post it.
The current code that I have cobbled together is below. I chose to use the "transpose" function due to the form having protected cells. a normal selection of cells for copy/paste prohibits this. there is additional cell information the is manually added that is not contained on the form. it is added to match the destination table (Access DB).
the biggest headache at the moment is finding the correct way to loop part of the code to transpose multiple rows/lines. Notes have been included in the code.
any guidance is appreciated.
I have a basic form that I want to automate into a sheet that can be used to input data into an access database. Due to the nature of the information on the form, I can not post it.
The current code that I have cobbled together is below. I chose to use the "transpose" function due to the form having protected cells. a normal selection of cells for copy/paste prohibits this. there is additional cell information the is manually added that is not contained on the form. it is added to match the destination table (Access DB).
the biggest headache at the moment is finding the correct way to loop part of the code to transpose multiple rows/lines. Notes have been included in the code.
any guidance is appreciated.
Code:
Sub Macro1()
'
' Macro1 Macro
'
'
Dim sh As Worksheet
Dim shName As String
'name of the sheet template
shName = "template.xltx"
'Insert sheet template
With ThisWorkbook
Set sh = Sheets.Add(Type:=Application.TemplatesPath & shName, _
after:=.Sheets(.Sheets.Count))
End With
'Give the sheet a name, today's date in this example
On Error Resume Next
sh.Name = Format(Text, "table1")
'This section (below) needs to loop/repeat until it finds a row with the first cell blank (transposing multiple rows - varies between forms)
Range("A2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[1]C[15])" 'This selection (A2) will stay the same for every row transposed (constant)
'The rest of this section will shift down 1 row until the blank row-cell is found
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Range("D2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Range("E2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Range("F2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Range("G2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Range("H2").Select
ActiveCell.FormulaR1C1 = _
"=IF('Inventory Material Disposition'!R[14]C[-1]="""","""",TRANSPOSE('Inventory Material Disposition'!R[14]C[-1]))"
Range("J2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Range("K2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Range("M2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Range("N2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Range("O2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Range("P2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Range("Q2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Range("R2").Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Range("A3").Select
'This section (above) needs to loop/repeat until it finds a row with the first cell blank
End Sub