SOLVED

Using VBA to take the data from a column and space it out into a row with 4 empty cells in between

Copper Contributor

I am trying to write code in VBA to take a column of data from one sheet and move it to one row in another sheet, but I also want there to be four empty cells in between each value in the row. The column of data won't always be the same number of data to take, so I'd like it to work for any amount of data in that column. Does anyone know how to write code for this?

 

For example, column C of values in sheet 1, not including the header, needs to be moved to E2, J2, O2 and so on in sheet 2 for however many results are in column C.

7 Replies
best response confirmed by JennaSmith495 (Copper Contributor)
Solution

@JennaSmith495 

Here you go. Modify the constants at the beginning for your setup.

Sub CopyAndSpace()
    ' Change the following as needed
    Const SourceSheet = "Sheet1"
    Const FirstSourceRow = 1
    Const SourceCol = "C"
    Const TargetSheet = "Sheet2"
    Const TargetRow = 2
    Const Interval = 5
    ' Variables
    Dim WSource As Worksheet
    Dim WTarget As Worksheet
    Dim SourceRow As Long
    Dim LastSourceRow As Long
    Dim TargetCol As Long
    ' Code to copy cells
    Application.ScreenUpdating = False
    Set WSource = Worksheets(SourceSheet)
    Set WTarget = Worksheets(TargetSheet)
    LastSourceRow = WSource.Cells(WSource.Rows.Count, SourceCol).End(xlUp).Row
    For SourceRow = FirstSourceRow To LastSourceRow
        TargetCol = TargetCol + Interval
        WTarget.Cells(TargetRow, TargetCol).Value = WSource.Cells(SourceRow, SourceCol).Value
    Next SourceRow
    Application.ScreenUpdating = True
End Sub

@Hans Vogelaar 

I keep getting "Object doesn't support this property or method" I tried adding as you have above under the rest of my code so it is on it's own sub, but that didn't work so I tried using with and adding it to the rest of my code. This is all very new to me so I'm not sure what I am doing wrong. Here is what I have currently, see anything amiss?

 

With Worksheets("PFAS Sum").CopyAndSpace()
Const SourceSheet = "PFAS sample info"
Const FirstSourceRow = 1
Const SourceCol = "C"
Const TargetSheet = "PFAS Sum"
Const TargetRow = 2
Const Interval = 5
Dim WSource As Worksheet
Dim WTarget As Worksheet
Dim SourceRow As Long
Dim LastSourceRow As Long
Dim TargetCol As Long
Application.ScreenUpdating = False
Set WSource = Worksheets(SourceSheet)
Set WTarget = Worksheets(TargetSheet)
LastSourceRow = WSource.Cells(WSource.Rows.Count, SourceCol).End(xlUp).Row
For SourceRow = FirstSourceRow To LastSourceRow
TargetCol = TargetCol + Interval
WTarget.Cells(TargetRow, TargetCol).Value = WSource.Cells(SourceRow, SourceCol).Value
Next SourceRow
Application.ScreenUpdating = True
End With

@JennaSmith495 

Why did you change Sub ... and End Sub to With ... and End With? I'm afraid that makes no sense.

@Hans Vogelaar 

Because the Sub didn't work. I entered this new sub code after the rest of my other code needed so there is a line between them. It generated a report with no error, but it didn't pull column C it just did the code I have in the beginning. 

 

Sub CopyAndSpace()
Const SourceSheet = "PFAS sample info"
Const FirstSourceRow = 1
Const SourceCol = "C"
Const TargetSheet = "PFAS Sum"
Const TargetRow = 2
Const Interval = 5
Dim WSource As Worksheet
Dim WTarget As Worksheet
Dim SourceRow As Long
Dim LastSourceRow As Long
Dim TargetCol As Long
Application.ScreenUpdating = False
Set WSource = Worksheets(SourceSheet)
Set WTarget = Worksheets(TargetSheet)
LastSourceRow = WSource.Cells(WSource.Rows.Count, SourceCol).End(xlUp).Row
For SourceRow = FirstSourceRow To LastSourceRow
TargetCol = TargetCol + Interval
WTarget.Cells(TargetRow, TargetCol).Value = WSource.Cells(SourceRow, SourceCol).Value
Next SourceRow
Application.ScreenUpdating = True
End Sub

I am creating a new tab with it, so it needs to fit in with the rest of this:

 

Private Sub cmdBuildSpreadsheet_Click()
Sheets.Add.Name = "PFAS Sum"
Range("B2").Value = ("NTN Site Code")
Range("B3").Value = ("NTN Site Name")
Range("B4").Value = ("NTN Sample ID")
Range("B5").Value = ("WSLH Sample ID")
Range("B6").Value = ("Collection Start")
Range("B7").Value = ("Collection End")
Range("B8").Value = ("Collection Duration")
Range("B9").Value = ("Percipitation Depth 9 cm")
Range("B10").Value = ("Volume Processed")
Range("B11").Value = ("Lab Receipt Date")
Range("B12").Value = ("Preparation Date")
Range("B13").Value = ("Analysis Date")
Range("B14").Value = ("Report Date")
Range("B15").Value = ("Report Units")
Range("B14").Value = ("Report Date")
Range("B19").Value = ("PFAS Compound")
Range("C19").Value = ("PFAS Code")
Range("B20").Value = ("PFBA (375-22-4)")
Range("B21").Value = ("PFPeA (2706-90-3)")
Range("B20").Value = ("PFBA (375-22-4)")
Range("B21").Value = ("PFPeA (2706-90-3)")
Range("B20").Value = ("PFBA (375-22-4)")
Range("B21").Value = ("PFPeA (2706-90-3)")
Range("B22").Value = ("PFBS (375-73-5)")
Range("B23").Value = ("4:2 FTSA (757124-72-4)")
Range("B24").Value = ("PFHxA (307-24-4)")
Range("B25").Value = ("PFPeS (2706-91-4)")
Range("B26").Value = ("HFPO-DA (13252-13-6)")
Range("B27").Value = ("PFHpA (375-85-9)")
Range("B28").Value = ("PFHxS (355-46-4)")
Range("B29").Value = ("DONA (919005-14-4)")
Range("B30").Value = ("6:2 FTSA (27619-97-2)")
Range("B31").Value = ("PFOA (335-67-1)")
Range("B32").Value = ("PFHpS (375-92-8)")
Range("B33").Value = ("PFOS (1763-23-1)")
Range("B34").Value = ("PFNA (375-95-1)")
Range("B35").Value = ("9Cl-PF3ONS (756426-58-1)")
Range("B36").Value = ("8:2 FTSA (39108-34-4)")
Range("B37").Value = ("PFDA (335-76-2)")
Range("B38").Value = ("PFNS (68259-12-1)")
Range("B39").Value = ("N-MeFOSAA (2355-31-9)")
Range("B40").Value = ("N-EtFOSAA (2991-50-6)")
Range("B41").Value = ("FOSA (754-91-6)")
Range("B42").Value = ("PFUnA (2058-94-8)")
Range("B43").Value = ("PFDS (335-77-3)")
Range("B44").Value = ("11Cl-PF3OUdS (763051-92-9)")
Range("B45").Value = ("PFDoA (307-55-1)")
Range("B46").Value = ("10:2 FTSA (120226-60-0)")
Range("B47").Value = ("PFDoS (79780-39-5)")
Range("B48").Value = ("PFTrDA (72629-94-8)")
Range("B49").Value = ("N-MeFOSA (31506-32-8)")
Range("B50").Value = ("N-MeFOSE (24448-09-7)")
Range("B51").Value = ("N-EtFOSA (4151-50-2)")
Range("B52").Value = ("N-EtFOSE (1691-99-2)")
Range("B53").Value = ("PFTeDA (376-06-7)")
Range("B54").Value = ("PFHxDA (67905-19-5)")
Range("B55").Value = ("PFODA (16517-11-6)")
Range("C20").Value = ("PFCA")
Range("C21").Value = ("PFCA")
Range("C22").Value = ("PFSA")
Range("C23").Value = ("FTSA")
Range("C24").Value = ("PFCA")
Range("C25").Value = ("PFSA")
Range("C26").Value = ("OTHER")
Range("C27").Value = ("PFCA")
Range("C28").Value = ("PFSA")
Range("C29").Value = ("OTHER")
Range("C30").Value = ("FTSA")
Range("C31").Value = ("PFCA")
Range("C32").Value = ("PFSA")
Range("C33").Value = ("PFSA")
Range("C34").Value = ("PFCA")
Range("C35").Value = ("OTHER")
Range("C36").Value = ("FTSA")
Range("C37").Value = ("PFCA")
Range("C38").Value = ("PFSA")
Range("C39").Value = ("FASA")
Range("C40").Value = ("FASA")
Range("C41").Value = ("FASA")
Range("C42").Value = ("PFCA")
Range("C43").Value = ("PFSA")
Range("C44").Value = ("OTHER")
Range("C45").Value = ("PFCA")
Range("C46").Value = ("FTSA")
Range("C47").Value = ("PFSA")
Range("C48").Value = ("PFCA")
Range("C49").Value = ("FASA")
Range("C50").Value = ("FASA")
Range("C51").Value = ("FASA")
Range("C52").Value = ("FASA")
Range("C53").Value = ("PFCA")
Range("C54").Value = ("PFCA")
Range("C55").Value = ("n.d.")
Range("B57").Value = ("Number of Compounds Detected")
Range("B58").Value = ("SUM of Concentrations (ng/L) or Flux (ng/m2/day)")
Range("B60").Value = ("PFCA")
Range("B61").Value = ("PFSA")
Range("B62").Value = ("FTSA")
Range("B63").Value = ("FASA")
Range("B64").Value = ("OTHER")
Range("B67").Value = ("Shafer 02/20/2020")
Range("B69").Value = ("QC Codes")
Range("B70").Value = ("Compound detected in Lab Blank")
Range("B71").Value = ("Laboratory Control Spike does not meet control limits")
Range("B72").Value = ("Interference")
Range("B73").Value = ("Internal Standard does not meet control limits")
Range("B74").Value = ("Transition Ion ratio does not meet control limits")
Range("B76").Value = ("QC Flags")
Range("B77").Value = ("Compound detected above the LOD")
Range("B78").Value = ("Compound detected between LOD and LOQ")
Range("B79").Value = ("Compound not detected (< LOD)")
Range("B80").Value = ("Level of Detection")
Range("B81").Value = ("Level of Quantification")
Range("A20").Value = ("1")
Range("A21").Value = ("2")
Range("A22").Value = ("3")
Range("A23").Value = ("4")
Range("A24").Value = ("5")
Range("A25").Value = ("6")
Range("A26").Value = ("7")
Range("A27").Value = ("8")
Range("A28").Value = ("9")
Range("A29").Value = ("10")
Range("A30").Value = ("11")
Range("A31").Value = ("12")
Range("A32").Value = ("13")
Range("A33").Value = ("14")
Range("A34").Value = ("15")
Range("A35").Value = ("16")
Range("A36").Value = ("17")
Range("A37").Value = ("18")
Range("A38").Value = ("19")
Range("A39").Value = ("20")
Range("A40").Value = ("21")
Range("A41").Value = ("22")
Range("A42").Value = ("23")
Range("A43").Value = ("24")
Range("A44").Value = ("25")
Range("A45").Value = ("26")
Range("A46").Value = ("27")
Range("A47").Value = ("28")
Range("A48").Value = ("29")
Range("A49").Value = ("30")
Range("A50").Value = ("31")
Range("A51").Value = ("32")
Range("A52").Value = ("33")
Range("A53").Value = ("34")
Range("A54").Value = ("35")
Range("A55").Value = ("36")
Range("C70").Value = ("LB")
Range("C71").Value = ("LC")
Range("C72").Value = ("IN")
Range("C73").Value = ("IS")
Range("C74").Value = ("TI")
Range("C77").Value = ("D")
Range("C78").Value = ("F")
Range("C79").Value = ("<")
Range("C80").Value = ("LOD")
Range("C81").Value = ("LOQ")
Range("F15").Value = ("Flag")
Range("G15").Value = ("QC")
Range("H15").Value = ("%")
Range("I15").Value = ("Flux")
Range("D2:D81").Interior.ColorIndex = 48

With Worksheets("PFAS Sum").Columns("B")
.ColumnWidth = .ColumnWidth * 5.5
End With
With Worksheets("PFAS Sum").Columns("C")
.ColumnWidth = .ColumnWidth * 1.5
End With
With Worksheets("PFAS Sum").Columns("D")
.ColumnWidth = .ColumnWidth * 0.5
End With

Worksheets("PFAS Sum").Range("B2:B15,A19:C67,B69,B76,C70:C74,C77:C81,F15:I15").Font.Bold = True
Range("B2:C15,B19:C19").BorderAround LineStyle:=xlContinuous, Weight:=xlThick
Range("B67,B69,B76").Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
Worksheets("PFAS Sum").Range("C60").Formula = "=COUNTIF(C20:C54,""PFCA"")"
Worksheets("PFAS Sum").Range("C61").Formula = "=COUNTIF(C20:C54,""PFSA"")"
Worksheets("PFAS Sum").Range("C62").Formula = "=COUNTIF(C20:C54,""FTSA"")"
Worksheets("PFAS Sum").Range("C63").Formula = "=COUNTIF(C20:C54,""FASA"")"
Worksheets("PFAS Sum").Range("C64").Formula = "=COUNTIF(C20:C54,""OTHER"")"
Worksheets("PFAS Sum").Range("E8").Formula = "=E7-E6"
Worksheets("PFAS Sum").Range("E57").Formula = "=COUNT(E20,E21,E24,E27,E31,E33,E34,E37,E42)"
Worksheets("PFAS Sum").Range("E58").Formula = "=SUM(E20,E21,E24,E27,E31,E33,E34,E37,E45)"
Worksheets("PFAS Sum").Range("E8").Formula = "=SUM(E20,E21,E24,E27,E31,E34,E37,E45)"

 

End Sub

1 best response

Accepted Solutions
best response confirmed by JennaSmith495 (Copper Contributor)
Solution

@JennaSmith495 

Here you go. Modify the constants at the beginning for your setup.

Sub CopyAndSpace()
    ' Change the following as needed
    Const SourceSheet = "Sheet1"
    Const FirstSourceRow = 1
    Const SourceCol = "C"
    Const TargetSheet = "Sheet2"
    Const TargetRow = 2
    Const Interval = 5
    ' Variables
    Dim WSource As Worksheet
    Dim WTarget As Worksheet
    Dim SourceRow As Long
    Dim LastSourceRow As Long
    Dim TargetCol As Long
    ' Code to copy cells
    Application.ScreenUpdating = False
    Set WSource = Worksheets(SourceSheet)
    Set WTarget = Worksheets(TargetSheet)
    LastSourceRow = WSource.Cells(WSource.Rows.Count, SourceCol).End(xlUp).Row
    For SourceRow = FirstSourceRow To LastSourceRow
        TargetCol = TargetCol + Interval
        WTarget.Cells(TargetRow, TargetCol).Value = WSource.Cells(SourceRow, SourceCol).Value
    Next SourceRow
    Application.ScreenUpdating = True
End Sub

View solution in original post