Forum Discussion

JennaSmith495's avatar
JennaSmith495
Copper Contributor
Sep 13, 2021
Solved

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

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 co...
Macros and VBA
  • HansVogelaar's avatar
    HansVogelaar
    Sep 13, 2021

    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
HansVogelaar's avatar
HansVogelaar
MVP
Sep 13, 2021

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
JennaSmith495's avatar
JennaSmith495
Copper Contributor
Sep 14, 2021

HansVogelaar 

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

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Sep 14, 2021

    JennaSmith495 

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

    • JennaSmith495's avatar
      JennaSmith495
      Copper Contributor
      Sep 14, 2021

      HansVogelaar 

      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

      • JennaSmith495's avatar
        JennaSmith495
        Copper Contributor
        Sep 14, 2021

        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

Resources