I have a single column of data with the last 2 digits being the subsection coordinates of the tables that I would like to create.
Input data
Column A
AA11
BB12
CC12
DD13
EE21
FF21
GG22
HH23
II23
JJ23
…
200 lines of data but fortunately maxes out at 6 tables by 3 tables so $Right , 1 or $Right , 2 provides the array coordinates easily
ZZZ63 max
Desired tables on one worksheet
3 columns
Column A. Column B. Column C.
AA BB DD
CC
EE GG HH
FF II
JJ
…..
ZZZ
I’ve created vba to do it the hard way but I am struggling to create an array that would like make this code so much cleaner and more effective.
as you can imagine lots of IsEmpty in the VBA I wrote.
I don’t want to use pivot tables.
I would appreciate any assistance to get me started.
Do Until I = r
J = Right$(Cells(I, "A"), 2)
If J = 11 Then
If IsEmpty(Cells(1, "B").Value) Then
Cells(1, "B").Value = Cells(I, "A").Value
k = 2
Else
Cells(k, "B").Value = Cells(I, "A").Value
If (k > M) Then M = k
k = k + 1
End If
ElseIf J = 12 Then
If IsEmpty(Cells(1, "C").Value) Then
Cells(1, "C").Value = Cells(I, "A").Value
k = 2
Else
Cells(k, "C").Value = Cells(I, "A").Value
k = k + 1
End If
ElseIf J = 13 Then
If IsEmpty(Cells(1, "D").Value) Then
Cells(1, "D").Value = Cells(I, "A").Value
k = 2
Else
Cells(k, "D").Value = Cells(I, "A").Value
k = k + 1
End If
ElseIf J = 21 Then
If IsEmpty(Cells(R2, "B").Value) Then
Cells(R2, "B").Value = Cells(I, "A").Value
k = R2 + 1
Else
Cells(k, "B").Value = Cells(I, "A").Value
k = k + 1
End If
ElseIf J = 22 Then
If IsEmpty(Cells(R2, "C").Value) Then
Cells(R2, "C").Value = Cells(I, "A").Value
k = R2 + 1
Else
Cells(k, "C").Value = Cells(I, "A").Value
k = k + 1
End If
ElseIf J = 23 Then
If IsEmpty(Cells(R2, "D").Value) Then
Cells(R2, "D").Value = Cells(I, "A").Value
k = R2 + 1
Else
Cells(k, "D").Value = Cells(I, "A").Value
k = k + 1
End If
ElseIf J = 31 Then
If IsEmpty(Cells(R3, "B").Value) Then
Cells(R3, "B").Value = Cells(I, "A").Value
k = R3 + 1
Else
Cells(k, "B").Value = Cells(I, "A").Value
k = k + 1
End If
ElseIf J = 32 Then
If IsEmpty(Cells(R3, "C").Value) Then
Cells(R3, "C").Value = Cells(I, "A").Value
k = R3 + 1
Else
Cells(k, "C").Value = Cells(I, "A").Value
k = k + 1
End If
ElseIf J = 33 Then
If IsEmpty(Cells(R3, "D").Value) Then
Cells(R3, "D").Value = Cells(I, "A").Value
k = R3 + 1
Else
Cells(k, "D").Value = Cells(I, "A").Value
k = k + 1
End If
ElseIf J = 41 Then
If IsEmpty(Cells(R4, "B").Value) Then
Cells(R4, "B").Value = Cells(I, "A").Value
k = R4 + 1
Else
Cells(k, "B").Value = Cells(I, "A").Value
k = k + 1
End If
ElseIf J = 42 Then
If IsEmpty(Cells(R4, "C").Value) Then
Cells(R4, "C").Value = Cells(I, "A").Value
k = R4 + 1
Else
Cells(k, "C").Value = Cells(I, "A").Value
k = k + 1
End If
ElseIf J = 43 Then
If IsEmpty(Cells(R4, "D").Value) Then
Cells(R4, "D").Value = Cells(I, "A").Value
k = R4 + 1
Else
Cells(k, "D").Value = Cells(I, "A").Value
k = k + 1
End If
ElseIf J = 51 Then
If IsEmpty(Cells(R5, "B").Value) Then
Cells(R5, "B").Value = Cells(I, "A").Value
k = R5 + 1
Else
Cells(k, "B").Value = Cells(I, "A").Value
k = k + 1
End If
ElseIf J = 52 Then
If IsEmpty(Cells(R5, "C").Value) Then
Cells(R5, "C").Value = Cells(I, "A").Value
k = R5 + 1
Else
Cells(k, "C").Value = Cells(I, "A").Value
k = k + 1
End If
ElseIf J = 53 Then
If IsEmpty(Cells(R5, "D").Value) Then
Cells(R5, "D").Value = Cells(I, "A").Value
k = R5 + 1
Else
Cells(k, "D").Value = Cells(I, "A").Value
k = k + 1
End If
End If
I = I + 1
Loop
New contributor
nDancer is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.