Transpose columns to rows and insert based upon conditions.

[d3mo]

Hi, I have a source data sheet that must be formatted for mass-upload process. This source data sheet holds data up to column W and columns O-V contain port#'s. Some ports contain a phone number and others are blank, column A holds ticket number, and the ports are transposed so that a ticket in the source data is only 1 row but the destination sheet can contain up to 8 rows because there are 8 ports. I use this code to accomplish this.

Sub TransposePorts()

Dim wsSrc As Worksheet, srcData, outData, r As Long
Dim c As Long, rOut As Long, p As Long, prt


'get input data as array
Set wsSrc = Worksheets("Sheet1")
srcData = wsSrc.Range("A2:W" & wsSrc.Cells(Rows.Count, "A").End(xlUp).Row).Value
'size output array to max potential size
ReDim outData(1 To 8 * UBound(srcData, 1), 1 To 16)

For r = 1 To UBound(srcData, 1) 'loop input data rows
For p = 1 To 8 'loop ports
prt = srcData(r, 14 + p)
If Len(prt) > 0 Then 'if any port value...
rOut = rOut + 1 'add output row
For c = 1 To 14 'populate common columns
outData(rOut, c) = srcData(r, c)
Next c
outData(rOut, 15) = prt 'add port value
outData(rOut, 16) = srcData(r, 23) 'col W value
End If
Next p
Next r

If rOut > 0 Then
Worksheets("Sheet2").Range("A2").Resize(rOut, UBound(outData, 2)).Value = outData
End If

End Sub

So right now, my macro will just look through the port columns and if it has a value, it will create a new row with all the same data in the other columns but a unique row for each port instead of a unique column for each port. The hard part is that I need logic added so that one condition is that source column F contains the term "Pepwave" and the other is that it contains the term "Data Remote". The destination sheet only has one column for serial, IMEI, and MAC, so how it fills this out depends on which device is being used. Image for clarification with all possible values in column F -

. If the source column contains a "Pepwave", I must insert 1 additional row for that set of ports that contains source columns A-E, the "PEP_BR1_CORE" with router serial, router IMEI, & router MAC from source sheet in the serial, imei, & mac address columns on destination sheet as shown here -

. The rows that were brought in with my macro (not inserted) will contain the ATA_2_Port or ATA_8_Port depending upon the hardware and the corresponding ATA serial and ATA mac from columns L & M on source data sheet. If column F on source data contains a "DataRemote", I want to pull serial, imei, & mac from source sheet columns G, H, & I, while ignoring sim and carrier on source sheet which are J & K. I am unsure if this makes sense or if anyone can help me with this because I it is a complicated ask.. but I have hit my limit for what I am capable of figuring out on this.

 

[d3mo]

Book4.xlsx
	Z
16
Sheet1

 

[d3mo]

This is output file

 

[d3mo]

I am able to get blank rows inserted properly with this code, but not sure how to add my conditions into it.

Sub test3()

Dim wsSrc As Worksheet, srcData, outData, r As Long
Dim c As Long, rOut As Long, p As Long, prt

'get input data as array
Set wsSrc = Worksheets("Sheet1")
srcData = wsSrc.Range("A2:W" & wsSrc.Cells(Rows.Count, "A").End(xlUp).Row).Value
'size output array to max potential size (+ added some space for pepwave/remote cases)
ReDim outData(1 To 10 * UBound(srcData, 1), 1 To 16)

For r = 1 To UBound(srcData, 1) 'loop input data rows
For p = 1 To 8 'loop ports
prt = srcData(r, 14 + p)
If Len(prt) > 0 Then 'if any port value...
rOut = rOut + 1 'add output row
For c = 1 To 14 'populate common columns
outData(rOut, c) = srcData(r, c)
Next c
outData(rOut, 15) = prt 'add port value
outData(rOut, 16) = srcData(r, 23) 'col W value
End If
Next p

'test to see if we're adding additional rows...
If InStr(1, srcData(r, 6), "pepwave", vbTextCompare) > 0 Then
rOut = rOut + 1
'populate pepwave row from srcdata (r,x)
End If
' If InStr(1, srcData(r, 6), "data remote", vbTextCompare) > 0 Then
' rOut = rOut + 1
' 'populate data remote row from srcdata (r,x)
' End If
'done testing for additional rows
Next r

If rOut > 0 Then
Worksheets("Sheet2").Range("A2").Resize(rOut, UBound(outData, 2)).Value = outData
End If

End Sub

 

[d3mo]

please delete, too confusing.