Transpose columns to rows and insert based upon conditions.

d3mo

New Member
Joined
Jul 13, 2021
Messages
5
Office Version
  1. 365
Platform
  1. Windows
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.
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

d3mo

New Member
Joined
Jul 13, 2021
Messages
5
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Jul 13, 2021
Messages
5
Office Version
  1. 365
Platform
  1. Windows
please delete, too confusing.
 

Forum statistics

Threads
1,141,068
Messages
5,704,099
Members
421,327
Latest member
Msh

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
Top