Creating macro to prep a form for Access DB input

F

fergyz

New Member
Joined
Jan 30, 2018
Messages
7
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.

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
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
not sure if either of these will work but feel free to try them on a copy of your workbook

Code: 
Sub Test1()Dim sh As Worksheet
Dim shName As String
Dim i As Intege, LastRow As Long
'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")
    
 'get last row
 LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
'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)
        
 For i = 2 To LastRow
'The rest of this section will shift down 1 row until the blank row-cell is found
Cells(i, 2).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 3).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 4).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 5).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 6).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 7).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 8).Select
ActiveCell.FormulaR1C1 = _
"=IF('Inventory Material Disposition'!R[14]C[-1]="""","""",TRANSPOSE('Inventory Material Disposition'!R[14]C[-1]))"
'Does column I need to be skipped?
Cells(i, 10).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 11).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 12).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 13).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 14).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 15).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 16).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 17).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 18).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"


Next i
Range("A3").Select
    
'This section (above) needs to loop/repeat until it finds a row with the first cell blank
    
End Sub


or more likely;

Code: 
Sub Test2()Dim sh As Worksheet
Dim shName As String
Dim i As Intege, LastRow As Long
'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")
    
 'get last row
 LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
'This section (below) needs to loop/repeat until it finds a row with the first cell blank (transposing multiple rows - varies between forms)
For i = 2 To LastRow


Cells(i, 1).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
Cells(i, 2).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 3).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 4).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 5).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 6).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 7).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 8).Select
ActiveCell.FormulaR1C1 = _
"=IF('Inventory Material Disposition'!R[14]C[-1]="""","""",TRANSPOSE('Inventory Material Disposition'!R[14]C[-1]))"
'Does column I need to be skipped?
Cells(i, 10).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 11).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 12).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 13).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 14).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 15).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 16).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 17).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"
Cells(i, 18).Select
ActiveCell.FormulaR1C1 = _
"=TRANSPOSE('Inventory Material Disposition'!R[14]C[-1])"


Next i


    
'This section (above) needs to loop/repeat until it finds a row with the first cell blank
    
End Sub
 
Upvote 0
Thank you for your help. currently, those codes aren't working for me. I took some time and made a test bed file to mimic what is being used.

This is the main sheet:


Book1
ABCDEFGHIJKLMNOPQ
1
2
3Transposed cell(constant for column "A")
4
5
6
7
8
9
10
11
12
13
14
15abcdefg/hijklmnopq
16Transposed cell A16Transposed cell B16Transposed cell c16Transposed cell d16Transposed cell e16Transposed cell f16Transposed cell g16Transposed cell I16Transposed cell j16Transposed cell k16Transposed cell l16Transposed cell M16Transposed cell n16Transposed cell o16Transposed cell p16Transposed cell q16
17Transposed cell A17Transposed cell B17Transposed cell c17Transposed cell d17Transposed cell e17Transposed cell f17Transposed cell g17Transposed cell I17Transposed cell j17Transposed cell k17Transposed cell l17Transposed cell M17Transposed cell n17Transposed cell o17Transposed cell p17Transposed cell q17
18texttexttextDropdown boxDropdown boxDropdown boxMerged and Centered potentially blanktextDropdown boxpotentially blank$$$FormulaFormulaFormulaDropdown boxpotentially blank
TestSheet
Cell Formulas
RangeFormula
P3Transposed cell(constant for column "A")
P15p
P16Transposed cell p16
P17Transposed cell p17
P18Dropdown box
A15a
A16Transposed cell A16
A17Transposed cell A17
A18text
B15b
B16Transposed cell B16
B17Transposed cell B17
B18text
C15c
C16Transposed cell c16
C17Transposed cell c17
C18text
D15d
D16Transposed cell d16
D17Transposed cell d17
D18Dropdown box
E15e
E16Transposed cell e16
E17Transposed cell e17
E18Dropdown box
F15f
F16Transposed cell f16
F17Transposed cell f17
F18Dropdown box
G15g/h
G16Transposed cell g16
G17Transposed cell g17
G18Merged and Centered potentially blank
I15i
I16Transposed cell I16
I17Transposed cell I17
I18text
J15j
J16Transposed cell j16
J17Transposed cell j17
J18Dropdown box
K15k
K16Transposed cell k16
K17Transposed cell k17
K18potentially blank
L15l
L16Transposed cell l16
L17Transposed cell l17
L18$$$
M15m
M16Transposed cell M16
M17Transposed cell M17
M18Formula
N15n
N16Transposed cell n16
N17Transposed cell n17
N18Formula
O15o
O16Transposed cell o16
O17Transposed cell o17
O18Formula
Q15q
Q16Transposed cell q16
Q17Transposed cell q17
Q18potentially blank


This is the output i am looking for:


Book1
ABCDEFGHIJKLMNOPQR
1ABCDEFGHBLANK -skipped (testsheet G/H) merged cell space req for ACDB input tableJKLMNOPQR
2Transposed cell(constant)Transposed cell A16Transposed cell B16Transposed cell c16Transposed cell d16Transposed cell e16Transposed cell f16Transposed cell g16Transposed cell I16Transposed cell j16Transposed cell k16Transposed cell l16Transposed cell M16Transposed cell n16Transposed cell o16Transposed cell p16Transposed cell q16
3Transposed cell(constant)Transposed cell A17Transposed cell B17Transposed cell c17Transposed cell d17Transposed cell e17Transposed cell f17Transposed cell g17Transposed cell I17Transposed cell j17Transposed cell k17Transposed cell l17Transposed cell M17Transposed cell n17Transposed cell o17Transposed cell p17Transposed cell q17
4Transposed cell(constant)Transposed cell A18Transposed cell B18Transposed cell c18Transposed cell d18Transposed cell e18Transposed cell f18Transposed cell g18Transposed cell I18Transposed cell j18Transposed cell k18Transposed cell l18Transposed cell M18Transposed cell n18Transposed cell o18Transposed cell p18Transposed cell q18
5Transposed cell(constant)Transposed cell A19Transposed cell B19Transposed cell c19Transposed cell d19Transposed cell e19Transposed cell f19Transposed cell g19Transposed cell I19Transposed cell j19Transposed cell k19Transposed cell l19Transposed cell M19Transposed cell n19Transposed cell o19Transposed cell p19Transposed cell q19
6Transposed cell(constant)Transposed cell A20Transposed cell B20Transposed cell c20Transposed cell d20Transposed cell e20Transposed cell f20Transposed cell g20Transposed cell I20Transposed cell j20Transposed cell k20Transposed cell l20Transposed cell M20Transposed cell n20Transposed cell o20Transposed cell p20Transposed cell q20
7Transposed cell(constant)Transposed cell A21Transposed cell B21Transposed cell c21Transposed cell d21Transposed cell e21Transposed cell f21Transposed cell g21Transposed cell I21Transposed cell j21Transposed cell k21Transposed cell l21Transposed cell M21Transposed cell n21Transposed cell o21Transposed cell p21Transposed cell q21
8Transposed cell(constant)Transposed cell A22Transposed cell B22Transposed cell c22Transposed cell d22Transposed cell e22Transposed cell f22Transposed cell g22Transposed cell I22Transposed cell j22Transposed cell k22Transposed cell l22Transposed cell M22Transposed cell n22Transposed cell o22Transposed cell p22Transposed cell q22
9Transposed cell(constant)Transposed cell A23Transposed cell B23Transposed cell c23Transposed cell d23Transposed cell e23Transposed cell f23Transposed cell g23Transposed cell I23Transposed cell j23Transposed cell k23Transposed cell l23Transposed cell M23Transposed cell n23Transposed cell o23Transposed cell p23Transposed cell q23
10Transposed cell(constant)Transposed cell A24Transposed cell B24Transposed cell c24Transposed cell d24Transposed cell e24Transposed cell f24Transposed cell g24Transposed cell I24Transposed cell j24Transposed cell k24Transposed cell l24Transposed cell M24Transposed cell n24Transposed cell o24Transposed cell p24Transposed cell q24
11Transposed cell(constant)Transposed cell A25Transposed cell B25Transposed cell c25Transposed cell d25Transposed cell e25Transposed cell f25Transposed cell g25Transposed cell I25Transposed cell j25Transposed cell k25Transposed cell l25Transposed cell M25Transposed cell n25Transposed cell o25Transposed cell p25Transposed cell q25
12Transposed cell(constant)Transposed cell A26Transposed cell B26Transposed cell c26Transposed cell d26Transposed cell e26Transposed cell f26Transposed cell g26Transposed cell I26Transposed cell j26Transposed cell k26Transposed cell l26Transposed cell M26Transposed cell n26Transposed cell o26Transposed cell p26Transposed cell q26
Final Requested Output
Cell Formulas
RangeFormula
A1A
A2Transposed cell(constant)
A3Transposed cell(constant)
A4Transposed cell(constant)
A5Transposed cell(constant)
A6Transposed cell(constant)
A7Transposed cell(constant)
A8Transposed cell(constant)
A9Transposed cell(constant)
A10Transposed cell(constant)
A11Transposed cell(constant)
A12Transposed cell(constant)
B1B
B2Transposed cell A16
B3Transposed cell A17
B4Transposed cell A18
B5Transposed cell A19
B6Transposed cell A20
B7Transposed cell A21
B8Transposed cell A22
B9Transposed cell A23
B10Transposed cell A24
B11Transposed cell A25
B12Transposed cell A26
C1C
C2Transposed cell B16
C3Transposed cell B17
C4Transposed cell B18
C5Transposed cell B19
C6Transposed cell B20
C7Transposed cell B21
C8Transposed cell B22
C9Transposed cell B23
C10Transposed cell B24
C11Transposed cell B25
C12Transposed cell B26
D1D
D2Transposed cell c16
D3Transposed cell c17
D4Transposed cell c18
D5Transposed cell c19
D6Transposed cell c20
D7Transposed cell c21
D8Transposed cell c22
D9Transposed cell c23
D10Transposed cell c24
D11Transposed cell c25
D12Transposed cell c26
E1E
E2Transposed cell d16
E3Transposed cell d17
E4Transposed cell d18
E5Transposed cell d19
E6Transposed cell d20
E7Transposed cell d21
E8Transposed cell d22
E9Transposed cell d23
E10Transposed cell d24
E11Transposed cell d25
E12Transposed cell d26
F1F
F2Transposed cell e16
F3Transposed cell e17
F4Transposed cell e18
F5Transposed cell e19
F6Transposed cell e20
F7Transposed cell e21
F8Transposed cell e22
F9Transposed cell e23
F10Transposed cell e24
F11Transposed cell e25
F12Transposed cell e26
G1G
G2Transposed cell f16
G3Transposed cell f17
G4Transposed cell f18
G5Transposed cell f19
G6Transposed cell f20
G7Transposed cell f21
G8Transposed cell f22
G9Transposed cell f23
G10Transposed cell f24
G11Transposed cell f25
G12Transposed cell f26
H1H
H2Transposed cell g16
H3Transposed cell g17
H4Transposed cell g18
H5Transposed cell g19
H6Transposed cell g20
H7Transposed cell g21
H8Transposed cell g22
H9Transposed cell g23
H10Transposed cell g24
H11Transposed cell g25
H12Transposed cell g26
I1BLANK -skipped (testsheet G/H) merged cell space req for ACDB input table
J1J
J2Transposed cell I16
J3Transposed cell I17
J4Transposed cell I18
J5Transposed cell I19
J6Transposed cell I20
J7Transposed cell I21
J8Transposed cell I22
J9Transposed cell I23
J10Transposed cell I24
J11Transposed cell I25
J12Transposed cell I26
K1K
K2Transposed cell j16
K3Transposed cell j17
K4Transposed cell j18
K5Transposed cell j19
K6Transposed cell j20
K7Transposed cell j21
K8Transposed cell j22
K9Transposed cell j23
K10Transposed cell j24
K11Transposed cell j25
K12Transposed cell j26
L1L
L2Transposed cell k16
L3Transposed cell k17
L4Transposed cell k18
L5Transposed cell k19
L6Transposed cell k20
L7Transposed cell k21
L8Transposed cell k22
L9Transposed cell k23
L10Transposed cell k24
L11Transposed cell k25
L12Transposed cell k26
M1M
M2Transposed cell l16
M3Transposed cell l17
M4Transposed cell l18
M5Transposed cell l19
M6Transposed cell l20
M7Transposed cell l21
M8Transposed cell l22
M9Transposed cell l23
M10Transposed cell l24
M11Transposed cell l25
M12Transposed cell l26
N1N
N2Transposed cell M16
N3Transposed cell M17
N4Transposed cell M18
N5Transposed cell M19
N6Transposed cell M20
N7Transposed cell M21
N8Transposed cell M22
N9Transposed cell M23
N10Transposed cell M24
N11Transposed cell M25
N12Transposed cell M26
O1O
O2Transposed cell n16
O3Transposed cell n17
O4Transposed cell n18
O5Transposed cell n19
O6Transposed cell n20
O7Transposed cell n21
O8Transposed cell n22
O9Transposed cell n23
O10Transposed cell n24
O11Transposed cell n25
O12Transposed cell n26
P1P
P2Transposed cell o16
P3Transposed cell o17
P4Transposed cell o18
P5Transposed cell o19
P6Transposed cell o20
P7Transposed cell o21
P8Transposed cell o22
P9Transposed cell o23
P10Transposed cell o24
P11Transposed cell o25
P12Transposed cell o26
Q1Q
Q2Transposed cell p16
Q3Transposed cell p17
Q4Transposed cell p18
Q5Transposed cell p19
Q6Transposed cell p20
Q7Transposed cell p21
Q8Transposed cell p22
Q9Transposed cell p23
Q10Transposed cell p24
Q11Transposed cell p25
Q12Transposed cell p26
R1R
R2Transposed cell q16
R3Transposed cell q17
R4Transposed cell q18
R5Transposed cell q19
R6Transposed cell q20
R7Transposed cell q21
R8Transposed cell q22
R9Transposed cell q23
R10Transposed cell q24
R11Transposed cell q25
R12Transposed cell q26
 
Upvote 0
ok, I have worked on the transpose loop;

Code: 
Sub Transpose()

Dim i As Integer, t As Integer, LastRow As Long


Sheets("Inventory Material Disposition").Select
LastRow = Cells(Rows.Count, "A").End(xlUp).Row


Sheets("Sheet2").Select 'Change this fr whichever sheet your transposing to


Range("A1:H1").Value = Array("A", "B", "C", "D", "E", "F", "G", "H")
Range("J1:R1").Value = Array("J", "K", "L", "M", "N", "O", "P", "Q", "R")


t = 16
For i = 2 To LastRow - 13 'Row 2 to last row
            Cells(i, 1).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Range("P3"))
                Cells(i, 2).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 1))
                Cells(i, 3).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 2))
                Cells(i, 4).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 3))
                Cells(i, 5).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 4))
                Cells(i, 6).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 5))
                Cells(i, 7).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 6))
                Cells(i, 8).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 7))
                Cells(i, 10).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 8))
                Cells(i, 11).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 10))
                Cells(i, 12).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 11))
                Cells(i, 13).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 12))
                Cells(i, 14).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 13))
                Cells(i, 15).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 14))
                Cells(i, 16).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 15))
                Cells(i, 17).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 16))
                Cells(i, 18).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 17))
            t = t + 1
        Next i


End Sub

let me know how this goes, I used your test info on a sheet named "Inventory Sheet Disposition"
and transposed it to "Sheet2"




I think this is it integrated into your code but I cannot test it:

Code: 
Sub IntegratedTranspose()

Dim i As Integer, t As Integer, LastRow As Long
Dim sh As Worksheet, shName As String

'_________________________________________________________________________________________________


Sheets("Inventory Material Disposition").Select
LastRow = Cells(Rows.Count, "A").End(xlUp).Row


'_________________________________________________________________________________________________


'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")


'_________________________________________________________________________________________________




Sheets("Sheet2").Select 'Change this fr whichever sheet your transposing to


Range("A1:H1").Value = Array("A", "B", "C", "D", "E", "F", "G", "H")
Range("J1:R1").Value = Array("J", "K", "L", "M", "N", "O", "P", "Q", "R")


t = 16
For i = 2 To LastRow - 13 'Row 2 to last row
            Cells(i, 1).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Range("P3"))
                Cells(i, 2).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 1))
                Cells(i, 3).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 2))
                Cells(i, 4).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 3))
                Cells(i, 5).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 4))
                Cells(i, 6).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 5))
                Cells(i, 7).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 6))
                Cells(i, 8).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 7))
                Cells(i, 10).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 8))
                Cells(i, 11).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 10))
                Cells(i, 12).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 11))
                Cells(i, 13).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 12))
                Cells(i, 14).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 13))
                Cells(i, 15).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 14))
                Cells(i, 16).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 15))
                Cells(i, 17).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 16))
                Cells(i, 18).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 17))
            t = t + 1
        Next i


End Sub
 
Last edited:
Upvote 0
apologies,

this line should be edited;

Code: 
Cells(i, 10).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 8))

it should be;

Code: 
Cells(i, 10).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, [B][COLOR=#ff0000]9[/COLOR][/B]))
 
Upvote 0
I can see light at the end of the tunnel. :biggrin:

Both of those worked with one small issue. the first blank column after the last row - has the first cell filled in with the "constant" and zeros for the rest of the columns. not sure what the best way is to prevent that.

what is the best way to incorporate the "if" statements with the way the code is written now? I had this in the original code:

Code: 
[COLOR=#333333]ActiveCell.FormulaR1C1 = _[/COLOR]"=IF('Inventory Material Disposition'!R[14]C[-1]="""","""",TRANSPOSE('Inventory Material Disposition'!R[14]C[-1]))"
 
Upvote 0
cooper645 said:
apologies,

this line should be edited;

Code: 
Cells(i, 10).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 8))

it should be;

Code: 
Cells(i, 10).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, [B][COLOR=#ff0000]9[/COLOR][/B]))
Click to expand...
I added this change.
 
Upvote 0
ok, no problem.

here are the two new codes - I have amended the line which I said to and added the if statement so you can copy and paste straight in.

one which I test and works;
Code: 
Sub Transpose()

Dim i As Integer, t As Integer, LastRow As Long


Sheets("Inventory Material Disposition").Select
LastRow = Cells(Rows.Count, "A").End(xlUp).Row


Sheets("Sheet2").Select 'Change this fr whichever sheet your transposing to


Range("A1:H1").Value = Array("A", "B", "C", "D", "E", "F", "G", "H")
Range("J1:R1").Value = Array("J", "K", "L", "M", "N", "O", "P", "Q", "R")


t = 16
For i = 2 To LastRow - 14 'Row 2 to last row
            Cells(i, 1).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Range("P3"))
                Cells(i, 2).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 1))
                Cells(i, 3).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 2))
                Cells(i, 4).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 3))
                Cells(i, 5).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 4))
                Cells(i, 6).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 5))
                Cells(i, 7).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 6))
                If Sheets("Inventory Material Disposition").Cells(t, 7) = "" Then
                Cells(i, 8).Value = ""
                Else
                Cells(i, 8).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 7))
                End If
                Cells(i, 10).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 9))
                Cells(i, 11).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 10))
                Cells(i, 12).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 11))
                Cells(i, 13).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 12))
                Cells(i, 14).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 13))
                Cells(i, 15).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 14))
                Cells(i, 16).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 15))
                Cells(i, 17).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 16))
                Cells(i, 18).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 17))
            t = t + 1
        Next i


End Sub

and the integrated one;
Code: 
Sub IntegratedTranspose()

Dim i As Integer, t As Integer, LastRow As Long
Dim sh As Worksheet, shName As String


Sheets("Inventory Material Disposition").Select
LastRow = Cells(Rows.Count, "A").End(xlUp).Row


'_________________________________________________________________________________________________


'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")


'_________________________________________________________________________________________________




Sheets("Sheet2").Select 'Change this fr whichever sheet your transposing to


Range("A1:H1").Value = Array("A", "B", "C", "D", "E", "F", "G", "H")
Range("J1:R1").Value = Array("J", "K", "L", "M", "N", "O", "P", "Q", "R")


t = 16
For i = 2 To LastRow - 14 'Row 2 to last row
            Cells(i, 1).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Range("P3"))
                Cells(i, 2).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 1))
                Cells(i, 3).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 2))
                Cells(i, 4).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 3))
                Cells(i, 5).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 4))
                Cells(i, 6).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 5))
                Cells(i, 7).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 6))
                If Sheets("Inventory Material Disposition").Cells(t, 7) = "" Then
                Cells(i, 8).Value = ""
                Else
                Cells(i, 8).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 7))
                End If
                Cells(i, 10).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 9))
                Cells(i, 11).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 10))
                Cells(i, 12).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 11))
                Cells(i, 13).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 12))
                Cells(i, 14).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 13))
                Cells(i, 15).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 14))
                Cells(i, 16).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 15))
                Cells(i, 17).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 16))
                Cells(i, 18).Value = WorksheetFunction.Transpose(Sheets("Inventory Material Disposition").Cells(t, 17))
            t = t + 1
        Next i


End Sub
 
Upvote 0
That finally took care of the last issue I had. I will take the "if" statement and apply it to a few more columns that need it.

Thanks for the help and finding the end of the tunnel. You converted about 5 minutes of work into roughly a 15-second job (start to finish) per person.
 
Upvote 0
Very glad to have helped.

All the best

Coops
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question Question
Macro not working after adding two new items
Replies
5
Views
439
regan_2000
R
C
  • Question Question
VBA: Filter specific data from table then make formula and put result to summary workbook
Replies
1
Views
599
HighAndWilder
H
P
  • Question Question
Trying to create Macro that will continuously copy and paste data from a drop down list
Replies
0
Views
346
psywagon
P
N
  • Question Question
Help merging two pieces of VBA code
Replies
8
Views
652
Nordicrx8
N
M
  • Solved
Add item to next cell on button click (with limited cells to use)
Replies
4
Views
521
mrfahaji
M

Forum statistics

Threads
1,223,888
Messages
6,175,213
Members
452,618
Latest member
Tam84

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top