Forum Discussion

gms4b's avatar
gms4b
Brass Contributor
Aug 05, 2019

modify VBA code to include dynamic columns instead of static

I have the following code which looks for the word "unknown" in column "4" (of sheet "Raw Data") and then copies the corresponding row of data to a different sheet ("undiluted"). However, sometimes t...
Macros and VBA
Haytham Amairah's avatar
Haytham Amairah
Silver Contributor
Aug 05, 2019

gms4b

 

Hi,

 

You can do this by a simple algorithm:

  • Search for the header of (Sample Type) in the worksheet using the Cell.Find method in VBA
  • Store the column number of the Sample Type header in a variable called: headerColumn
  • Use this variable in place of the number 4 in the IF statement's logical test

 

So the code looks like this:

Sub test()
    Application.ScreenUpdating = False
    
    Dim a As Long
    a = Worksheets("Raw Data").Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim headerColumn As Long
    headerColumn = Cells.Find(What:="Sample Type", After:=Range("A1"), LookIn:=xlFormulas, _
                   LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                   MatchCase:=False, SearchFormat:=False).Column
                   
    For i = 2 To a
        If Worksheets("Raw Data").Cells(i, headerColumn).Value = "Unknown" Then
            Worksheets("Raw Data").Rows(i).Copy
            Worksheets("Undiluted").Activate
            Dim b As Long
            b = Worksheets("Undiluted").Cells(Rows.Count, 1).End(xlUp).Row
            Worksheets("Undiluted").Cells(b + 1, 1).Select
            ActiveSheet.Paste
            Worksheets("Raw Data").Activate
        End If
    Next
    
    Application.CutCopyMode = False
    ThisWorkbook.Worksheets("Raw Data").Cells(1, 1).Select
    Application.ScreenUpdating = True
End Sub

 

Hope that helps

  • gms4b's avatar
    gms4b
    Brass Contributor
    Aug 05, 2019

    Haytham Amairah 

     

    oooo. Nice, it works! Thanks!!

     

    Another question? What if I also wanted to look for "Quality Control" in addition to "Unknown"....so, any row that had "Quality Control" or "Unknown" in a column with "Sample Type" as the header would get moved to the "Undiluted" sheet.

     

    Thanks!

     

    Greg

     

    • gms4b's avatar
      gms4b
      Brass Contributor
      Aug 05, 2019

      gms4b 

      @Haytham Amairah 

       

      Nevermind....figured it out: 

       

      If (Worksheets("Raw Data").Cells(i, headerColumn).Value = "Unknown" Or Worksheets("Raw Data").Cells(i, headerColumn).Value = "Quality Control") Then

       

      Thanks!

      • gms4b's avatar
        gms4b
        Brass Contributor
        Aug 06, 2019

        @Haytham Amairah 

         

        Ha!! Got it!

        It took awhile, but got it figured out. Now....need to find a way to copy the column headers (Row 1) from "Raw Data" to the "Undiluted" and "Diluted" sheets.

         

         

        -----------------------------------------------------------------

        Private Sub CommandButton1_Click()


        Application.ScreenUpdating = False

        Dim a As Long

        a = Worksheets("Raw Data").Cells(Rows.Count, 1).End(xlUp).Row

        Dim headerColumn1 As Long
        headerColumn1 = Cells.Find(What:="Sample Type", After:=Range("A1"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Column
        Dim headerColumn2 As Long
        headerColumn2 = Cells.Find(What:="Dilution Factor", After:=Range("A1"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Column

        For i = 2 To a
        If ((Worksheets("Raw Data").Cells(i, headerColumn1).Value = "Unknown" Or Worksheets("Raw Data").Cells(i, headerColumn1).Value = "Quality Control") And Worksheets("Raw Data").Cells(i, headerColumn2).Value = "1") Then
        Worksheets("Raw Data").Rows(i).Copy
        Worksheets("Undiluted").Activate
        Dim b As Long
        b = Worksheets("Undiluted").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Undiluted").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Raw Data").Activate
        End If

        If ((Worksheets("Raw Data").Cells(i, headerColumn1).Value = "Unknown" Or Worksheets("Raw Data").Cells(i, headerColumn1).Value = "Quality Control") And Worksheets("Raw Data").Cells(i, headerColumn2).Value > 1) Then
        Worksheets("Raw Data").Rows(i).Copy
        Worksheets("Diluted").Activate
        Dim c As Long
        c = Worksheets("Diluted").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Diluted").Cells(c + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Raw Data").Activate
        End If


        Next

        Application.CutCopyMode = False
        ThisWorkbook.Worksheets("Raw Data").Cells(1, 1).Select
        Application.ScreenUpdating = True

        End Sub

Resources