How to add data from one column to two created columns? - excel

Question

I would like my Column named "Total Board Quantit" to have all its data go to two created columns named "Total Pallets" and "Total Boards".
Total Boards will have all values from Total Board Quantit that are greater than 28.01.
Total Pallets will have all values lower than or equal to 28.
There's also data in Total Board Quantit that are lower than 1 that I do not want to show which should be on the macro already.
Option Explicit
Sub DATA()
Dim ws As Worksheet 'Dim, dimension. Declare variable to be used later
On Error Resume Next 'Continues executing statement, ignores error
Application.DisplayAlerts = False 'Set to false to suppres prompts
Sheets("DATA").Delete
Application.DisplayAlerts = True
On Error GoTo 0 'Disables any error trapping currently present in the procedure
Dim fName As Variant, wb As Workbook 'Variant data type can be used to define variables that contain any type of data
Application.EnableEvents = False 'Disable events to avoid workbooks_open to be started
fName = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*") 'fname, file with excel file ext
On Error Resume Next 'Continues executing statement, ignores error
If fName = False Then 'False, exit, msg will show
MsgBox ("No SAP Data selected!")
Exit Sub
End If
On Error GoTo 0
Set wb = Workbooks.Open(fName)
wb.Sheets(1).Copy before:=ThisWorkbook.Sheets(2) 'Importing data from first sheet on to this wb, second location
ActiveSheet.Name = "DATA" 'Naming the sheet DATA
wb.Close False 'Close workbook
On Error Resume Next
Application.EnableEvents = True
'''
Dim rngUsernameHeader As Range
Dim rngHeaders As Range
Set rngHeaders = Range("1:1") 'Looks in entire first row.
Set rngUsernameHeader = rngHeaders.Find(what:="Total Pallet Quantit", After:=Cells(1, 1))
rngUsernameHeader.Offset(0, 1).EntireColumn.Insert
rngUsernameHeader.Offset(0, 1).Value = "Total Pallets"
rngUsernameHeader.Offset(0, 2).EntireColumn.Insert
rngUsernameHeader.Offset(0, 2).Value = "Total Boards"
ActiveSheet.Range("$A$1:$P$247").AutoFilter Field:=16, Criteria1:=">1", _
Operator:=xlAnd
'''
Dim arrIn, arrOut As Variant
lastRow = Range("a" & Rows.Count).End(xlUp).Row
arrIn = rngUsernameHeader.Offset(1, 0).Resize(lastRow, 1).Value
ReDim arrOut(1 To UBound(arrIn), 1 To 2)
For x = 1 To UBound(arrIn)
num = arrIn(x, 1)
If num <= 28 Then
arrOut(x, 2) = num
ElseIf num >= 28.01 Then
arrOut(x, 1) = num
End If
Next x
rngUsernameHeader.Offset(1, 1).Resize(lastRow, 2).Value = arrOut
End Sub
What I'm getting

Answer 1

So you have inserted the two columns and now want to populate them with data.
I think here arrays are your friend:
Edited for comment by #TimWilliams, thanks!
Sub arrayTransfer()
Dim arrIn, arrOut As Variant
lastRow = Range("a" & Rows.Count).End(xlUp).Row
arrIn = Range("A2:A" & Range("a" & Rows.Count).End(xlUp).Row).Value
ReDim arrOut(1 To UBound(arrIn), 1 To 2)
For x = 1 To UBound(arrIn)
num = arrIn(x, 1)
If num <= 28 Then
arrOut(x, 2) = num
ElseIf num > 28.01 Then
arrOut(x, 1) = num
End If
Next x
Range("b2:c" & lastRow).Value = arrOut
End Sub
update lines 4 and 6 to reference the column the data is actually in and the last line to the columns the data is going into
note if a value is 28.01 or negative it will not be in either column as per the questions.
let me know how you get on