Using VBA arrays to synchronize three sheets into one - arrays

Question

I managed to sync selected data from three sheets into a fourth sheet. But the data doesn't align properly after empty cells beginning with the 14th row.
Now I'm trying to use arrays to align my data better. I have 3 sheets with columns Area, Zone, Employee and 6 numeric columns for each employee.
The data in Area, Zone & Employee is repeating itself in multiple rows so I need to add the numbers for every employee to have the Employee Name displayed only once with added data in other 6 columns.
I don't really have problem with filtering the names and adding data, but I'm not sure how to do it using arrays.
Or if anyone could help me find a mistake in my code that's causing the data to not align properly, I would also appreciate it. Below is my code so far, hopefully it would help.
Private Sub cmd_button1_Click()
Dim WS1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Set WS1 = Sheets("Sheet2")
Set ws2 = Sheets("Distribution")
Set ws3 = Sheets("Sheet3")
Set ws4 = Sheets("Sheet4")
Dim LastRow As Long
Dim R As Long, LR As Long, n As Long
Application.ScreenUpdating = False
'Getting the row number of last cell
LastRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
'Deleting any previous data from destination sheet
ws2.Range("A2:AX10000").ClearContents
For i = 1 To 10
'If value in V column of the row is "" then copy the row to destination sheet
If WS1.Cells(i, "V").Value = "" Then
WS1.Range("E:E").Copy Destination:=ws2.Range("A1")
WS1.Range("F:F").Copy Destination:=ws2.Range("B1")
WS1.Range("G:G").Copy Destination:=ws2.Range("C1")
WS1.Range("A:A").Copy Destination:=ws2.Range("E1")
WS1.Range("O:O").Copy Destination:=ws2.Range("F1")
WS1.Range("P:P").Copy Destination:=ws2.Range("G1")
WS1.Range("R:R").Copy Destination:=ws2.Range("H1")
WS1.Range("S:S").Copy Destination:=ws2.Range("I1")
WS1.Range("Q:Q").Copy Destination:=ws2.Range("J1")
WS1.Range("T:T").Copy Destination:=ws2.Range("K1")
ws3.Range("E:E").Copy Destination:=ws2.Range("L1")
ws3.Range("F:F").Copy Destination:=ws2.Range("M1")
ws3.Range("G:G").Copy Destination:=ws2.Range("N1")
ws3.Range("A:A").Copy Destination:=ws2.Range("O1")
ws3.Range("S:S").Copy Destination:=ws2.Range("P1")
ws3.Range("T:T").Copy Destination:=ws2.Range("Q1")
ws3.Range("V:V").Copy Destination:=ws2.Range("R1")
ws3.Range("W:W").Copy Destination:=ws2.Range("S1")
ws3.Range("X:X").Copy Destination:=ws2.Range("T1")
ws4.Range("F:F").Copy Destination:=ws2.Range("U1")
ws4.Range("G:G").Copy Destination:=ws2.Range("V1")
ws4.Range("H:H").Copy Destination:=ws2.Range("W1")
ws4.Range("A:A").Copy Destination:=ws2.Range("X1")
ws4.Range("L:L").Copy Destination:=ws2.Range("Y1")
ws4.Range("M:M").Copy Destination:=ws2.Range("Z1")
ws4.Range("N:N").Copy Destination:=ws2.Range("AA1")
ws4.Range("O:O").Copy Destination:=ws2.Range("AB1")
ws4.Range("P:P").Copy Destination:=ws2.Range("AC1")
ws4.Range("Q:Q").Copy Destination:=ws2.Range("AD1")
End If
Next i
LR = Cells(Rows.Count, "C").End(xlUp).Row
Range("A2:AX" & LR).Sort Key1:=Range("A2"), Order1:=xlAscending
For R = 2 To LR
'Count the number of duplicates for third row
n = Application.CountIf(Columns(3), Cells(R, 3).Value)
'Sum up the values for every duplicate
Range("F" & R).Value = Evaluate("=Sum(F" & R & ":F" & R + n - 1 & ")")
Range("G" & R).Value = Evaluate("=Sum(G" & R & ":G" & R + n - 1 & ")")
Range("H" & R).Value = Evaluate("=Sum(H" & R & ":H" & R + n - 1 & ")")
Range("I" & R).Value = Evaluate("=Sum(I" & R & ":I" & R + n - 1 & ")")
Range("J" & R).Value = Evaluate("=Sum(J" & R & ":J" & R + n - 1 & ")")
Range("K" & R).Value = Evaluate("=Sum(K" & R & ":K" & R + n - 1 & ")")
Range("E" & R).Value = Evaluate("=Count(E" & R & ":E" & R + n - 1 & ")")
'Go to next value in third column
R = R + n - 1
Next R
On Error Resume Next
'Remove all duplicates
ws2.Range("$A$1:$K$7979").RemoveDuplicates Columns:=3, Header:=xlYes
On Error GoTo 0
'Fill out the table with values
Columns("A:K").AutoFit
Application.ScreenUpdating = True
Range("A1").Select
End Sub
The code above is for synchronizing the sheets with Distribution and filter the data from Sheet2, and I have 2 more buttons made to filter the other 2 sheets.
The code below is my attempt to align the data but it's not working correctly.
Sub LineEmUp()
Dim i As Long, j As Long, LR As Long
Application.ScreenUpdating = False
LR = Range("C" & Rows.Count).End(xlUp).Row
Columns("A:K").Sort Key1:=Range("A2"), _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Columns("L:T").Sort Key1:=Range("L2"), _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Columns("U:AD").Sort Key1:=Range("U2"), _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
i = 2
Do
If Cells(i, "C") > Cells(i, "N") And Cells(i, "C") > "" Then
Cells(i, "A").Resize(1, 10).Insert xlShiftDown
ElseIf Cells(i, "N") > Cells(i, "W") And Cells(i, "N") > "" Then
Cells(i, "L").Resize(1, 10).Insert xlShiftDown
ElseIf Cells(i, "W") > Cells(i, "C") And Cells(i, "W") > "" Then
Cells(i, "U").Resize(1, 10).Insert xlShiftDown
ElseIf Cells(i, "C") < Cells(i, "N") And Cells(i, "C") > "" Then
Cells(i, "L").Resize(1, 10).Insert xlShiftDown
ElseIf Cells(i, "N") < Cells(i, "W") And Cells(i, "N") > "" Then
Cells(i, "U").Resize(1, 10).Insert xlShiftDown
ElseIf Cells(i, "W") < Cells(i, "C") And Cells(i, "W") > "" Then
Cells(i, "A").Resize(1, 10).Insert xlShiftDown
End If
i = i + 1
Loop Until Cells(i, "C") = "" And Cells(i, "W") = ""
Application.ScreenUpdating = True
End Sub
Hope I explained it properly. Thanks

Answer 1

Organization (without unnecessary repetition) is always important in coding, and especially key when troubleshooting. For example, your 29 copy-paste statements can be tidied up considerably - which shows some inconsistencies.
...I sorted them by source worksheet and then by source column, and grouped them together, also pasting into columns instead of single cells.
Edit:
There's a number of "weird things" going on here that require some explanation so I know whether they're designed this way intentionally.
**See my "'<<<<<<" notes below (There are some specific questions, starting with *what happens if you don't disable screen updating, and don't ignore the errors with On Error Resume Next...?
Option Explicit
Private Sub cmd_button1_Click()
Dim WS1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Set WS1 = Sheets("Sheet2")
Set ws2 = Sheets("Distribution")
Set ws3 = Sheets("Sheet3")
Set ws4 = Sheets("Sheet4")
'Dim LastRow As Long
Dim R As Long, LR As Long, n As Long, i As Integer
' <<<<< always ALLOW screen updating during troubleshooting, until your code
' <<<<< is functioning perfectly: It may give a clue to the problem.
'Application.ScreenUpdating = False
'Getting the row number of last cell '<<<<< variable [LastRow] is not being used.
'LastRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
'Deleting any previous data from destination sheet
'ws2.Range("A2:AX10000").ClearContents
ws2.UsedRange.ClearContents ' <<<<<< instead of specifying a range, just clear what's used
For i = 1 To 10
'If value in V column of the row is "" then copy the row to destination sheet
If WS1.Cells(i, "V").Value = "" Then
WS1.Range("A:A").Copy Destination:=ws2.Range("E:E") '<<< there's no pattern to what's being copied,
WS1.Range("E:G").Copy Destination:=ws2.Range("A:C") '<<< (and in a strange criss-cross),
WS1.Range("O:S").Copy Destination:=ws2.Range("F:I") '<<< are you sure nothing's being missed?
WS1.Range("T:T").Copy Destination:=ws2.Range("K:K")
ws3.Range("A:A").Copy Destination:=ws2.Range("O:O")
ws3.Range("E:G").Copy Destination:=ws2.Range("L:N")
ws3.Range("S:T").Copy Destination:=ws2.Range("P:Q")
ws3.Range("V:X").Copy Destination:=ws2.Range("R:T")
ws4.Range("A:A").Copy Destination:=ws2.Range("X1")
ws4.Range("F:H").Copy Destination:=ws2.Range("U:W")
ws4.Range("L:Q").Copy Destination:=ws2.Range("Y:AD")
End If
Next i
LR = Cells(Rows.Count, "C").End(xlUp).Row
Range("A2:AX" & LR).Sort Key1:=Range("A2"), Order1:=xlAscending '<<<<< this could be a problem??
For R = 2 To LR
'Count the number of duplicates for third row
n = Application.CountIf(Columns(3), Cells(R, 3).Value)
'Sum up the values for every duplicate
Range("F" & R).Value = Evaluate("=Sum(F" & R & ":F" & R + n - 1 & ")") '<<<<<< this is a strange way to do this...,
Range("G" & R).Value = Evaluate("=Sum(G" & R & ":G" & R + n - 1 & ")") '<<<<<< can you explain the purpose of these lines?
Range("H" & R).Value = Evaluate("=Sum(H" & R & ":H" & R + n - 1 & ")") '<<<<<< why not just add the cells normally instead like this?
Range("I" & R).Value = Evaluate("=Sum(I" & R & ":I" & R + n - 1 & ")")
Range("J" & R).Value = Evaluate("=Sum(J" & R & ":J" & R + n - 1 & ")")
Range("K" & R).Value = Evaluate("=Sum(K" & R & ":K" & R + n - 1 & ")")
Range("E" & R).Value = Evaluate("=Count(E" & R & ":E" & R + n - 1 & ")")
'Go to next value in third column
R = R + n - 1 '<<<<< WOAH! don't change the value of R when it's being used inside a loop!!!
Next R
'On Error Resume Next '<<<<< Errors mean something - Don't ignore them! (especially during troubleshooting)
'Remove all duplicates
ws2.Range("$A$1:$K$7979").RemoveDuplicates Columns:=3, Header:=xlYes '<<< this shifts cells around, might be a problem
On Error GoTo 0
'Fill out the table with values
Columns("A:K").AutoFit
Application.ScreenUpdating = True
Range("A1").Select
End Sub