modify VBA code to include dynamic columns instead of static

Brass Contributor

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 this data is found in different columns (column 3, 5, 6, etc). How would you code this so that it looks for the header ("Sample Type") and uses this column instead of just column "4"?

 

Thanks,


Greg

 

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

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

For i = 2 To a


If Worksheets("Raw Data").Cells(i, 4).Value = "Unknown" Then

Worksheets("Raw Data").Rows(i).Copy
Worksheets("Undiluted").Activate
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

End Sub

30 Replies

@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

@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 

@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!

@Haytham Amairah

 

Time for another question?

 

So, I did another algorithm to define another column header....."Dilution Factor" and changed your original line to:

If (Worksheets("Raw Data").Cells(i, headerColumn1).Value = "Unknown" And Worksheets("Raw Data").Cells(i, headerColumn2).Value = "1") Then

 

And, this works, -----> if "Unknown" and "1" then copy to "Undiluted" sheet.

 

But, I'm having a hard time trying to add in 3 more conditions I'd like:

 

if "Unknown" and ">1" then copy to "Diluted" sheet.

if "Quality Control" and "1" then copy to "Undiluted" sheet.

if "Quality Control" and ">1" then copy to "Undiluted" sheet.

 

--or a simpler way to look at it

 

if ("Unknown" or "Quality Control") and "1" then copy to "Undiluted" Sheet

if ("Unknown" or "Quality Control") and ">1" then copy to "Diluted" Sheet

 

I tried a few things and can't get it to work right. I'm not a programmer...just a chemist! Trying to make my life easier.

 

Thanks for your help!

 

Greg

 

here's the code where I left off.....which works:

 

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

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" 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


Next

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

End Sub

@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

@gms4b

 

Hi,

 

Sorry about the late reply as I was too busy!

Is the problem solved?
Did you need anything else?
If not, please let me know and provide a sample of the data you work on to be able to figure it out.
 
Regards

@Haytham Amairah 

 

Thanks for getting back to me. I believe that I have solved everything so far. Thanks for getting me started....I was able to make it work from there. Thanks for the offer to help out in the future.

 

Greg

 

 

@Haytham Amairah 

 

Alright...I have another project for you! This builds on the previous code....It could be on a separate commandbutton, but ultimately I'd like to just add it to the end of the previous code.

 

And if you can get me started I can likely hack my way though the rest to fill out the whole idea.

 

Basically, I need to move columns from one sheet to another sheet ("Undiluted" to "UndilutedPLUS" and "Diluted" to "Diluted Plus"). The columns will be variable, so, like you showed before, I could used cells.find to define all of the columns that I'll need (probably 10-12 columns in all). 

 

So, actually, building on the code before, if you could show me how to move headercolumn1 (i.e. "Sample type") from sheet "Undiluted" to an empty sheet "UndilutedPLUS" and put it in cell A2......then I ought to be able to figure out how to define more columns and line them up in B2, C2, D2, etc. and also move columns from "Diluted" to "Diluted Plus."

 

The code as it stands is below....and I also attached the file ("Example with VBA4.xlsm" which has the data and code). 

 

(I'm guessing that somewhere you'll have to define a new worksheet (for the "Undiluted" sheet) and then use cells.find and define all of the columns there?)

 

 

I hope this isn't too much! Thanks for your help,

 

Greg

 

 

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

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

Sheets("Raw Data").Range("A1:CZ1").Copy Destination:=Sheets("Undiluted").Range("A1:CZ1")
Sheets("Raw Data").Range("A1:CZ1").Copy Destination:=Sheets("Diluted").Range("A1:CZ1")


Next

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

End Sub

 

@gms4b

 

Hi,

 

As I understand, you want to move specific entire columns to other sheets, not some rows based on a condition?

@Haytham Amairah 

 

Yes, just specific columns.

 

Part one of this automation is taking the raw data and sorting it by rows into two sheets based on conditions (0 or >1).....and that code works great. That also gets rid of rows that I don't need.

 

Part two cleans up the data even more by getting rid of columns that I don't need.....by copying specific columns to a fresh sheet. I'll have normal excel formulas to the right of that data....I don't think VBA is necessary for that. So, in this case, there are no conditions that I need to be worried about (other than the name of the column header). I just need to move specific columns to new sheets.

 

Thanks,


Greg

 

@gms4b

 

Hi,

 

Please try this code to move the needed columns from Undiluted to UndilutedPLUS.

Sub test2()

Application.ScreenUpdating = False
    
    Dim i As Integer
    i = 0
    
    Sheets("Undiluted").Activate
    Dim columnNamesArray() As Variant
    columnNamesArray = Array("Analyte Peak Name", "Sample Type", "Rack Type", "Vial Position")
    
    Dim columnName As Variant
    For Each columnName In columnNamesArray
    
    Sheets("Undiluted").Activate
    
    Dim columnNumber As Integer
    columnNumber = Cells.Find(What:=columnName, After:=Range("A1"), LookIn:=xlFormulas, _
                   LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                   MatchCase:=False, SearchFormat:=False).Column
                   
    Cells(1, columnNumber).EntireColumn.Copy
    
    Sheets("UndilutedPLUS").Activate
    Range("A1").Activate
    ActiveCell.Offset(0, i).Select
    ActiveSheet.Paste
    i = i + 1
    Next columnName

Range("A1").Activate
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

Please note that you have to define the needed columns you want to move in the code.

You can insert them into the columnNamesArray.

 

Hope that helps

@Haytham Amairah 

 

Thanks for the code. I like the idea of creating an array so I don't have to define each column individually.

 

Right now there is a Runtime Error 1004 (Activate method of Range Class failed) at the line that says:

 

Range("A1").activate

 

I added this code as a second command button. The first button does the first part of code (and works fine). The second button activates this new code.

 

Greg

 

@gms4b

 

The error is caused by some ambiguity because the code was run using a button embedded on the worksheet.

To remove the ambiguity, fix the code as follows:

 

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
    
    Dim i As Integer
    i = 0
    
    Sheets("Undiluted").Activate
    Dim columnNamesArray() As Variant
    columnNamesArray = Array("Analyte Peak Name", "Sample Type", "Rack Type", "Vial Position")
    
    Dim columnName As Variant
    For Each columnName In columnNamesArray
    
    Sheets("Undiluted").Activate
    
    Dim columnNumber As Integer
    columnNumber = Cells.Find(What:=columnName, After:=Range("A1"), LookIn:=xlFormulas, _
                   LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                   MatchCase:=False, SearchFormat:=False).Column
                   
    Cells(1, columnNumber).EntireColumn.Copy
    
    Sheets("UndilutedPLUS").Activate
    Sheets("UndilutedPLUS").Range("A1").Select
    ActiveCell.Offset(0, i).Select
    ActiveSheet.Paste
    i = i + 1
    Next columnName

ActiveSheet.Range("A1").Activate
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


End Sub

 

 

Hope that helps

@Haytham Amairah 

 

Yes...that mostly fixed the problem, thanks. I added in all of the exact headers that I want and it copies them just fine. However, it's picking data from Sheet1 (i.e. "Raw Data") and moving it.

 

I had to more specifically specify which sheets to copy from by changing the line below.

 

Sheets("Undiluted").Cells(1, columnNumber).EntireColumn.Copy

 

Then it moves everything correctly! I'm not sure why it was still pulling from "Raw Data" when "Undiluted" was activated, but that fixes it.

 

I'm sure I'll have more questions....but for now, I'm good. 

 

Thanks!

 

Greg

 

 

 

@Haytham Amairah 

 

So, I'm having a hard time now figuring out how to add a second loop(?) to do the same thing for the "Diluted" and "DilutedPLUS" sheets. I guess you'd have to add "j as an integer" at the beginning, but then I get lost after that, lol. I can't figure out where to trigger the second loop with the new sheet names.

 

Thanks,


Greg

 

(current code below)

 

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

Private Sub CommandButton2_Click()

Application.ScreenUpdating = False

Dim i As Integer
i = 0

Sheets("Undiluted").Activate
Dim columnNamesArray() As Variant
columnNamesArray = Array("Sample Type", "Sample Name", "Acquisition Date", "File Name", "Dilution Factor", "Analyte Peak Name", "Analyte Concentration", "Calculated Concentration (")

Dim columnName As Variant
For Each columnName In columnNamesArray

Sheets("Undiluted").Activate

Dim columnNumber As Integer
columnNumber = Cells.Find(What:=columnName, After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Column

Sheets("Undiluted").Cells(1, columnNumber).EntireColumn.Copy

Sheets("UndilutedPLUS").Activate
Sheets("UndilutedPLUS").Range("A1").Select
ActiveCell.Offset(0, i).Select
ActiveSheet.Paste
i = i + 1
Next columnName

ActiveSheet.Range("A1").Activate
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

 

End Sub

@gms4b 

I suspect that with the newest releases of Office 365 most of the things described here can be done easily with worksheet formulas.  The points to observe are that all raw data should be entered into Excel Tables so that the field to be searched for the value "Unknown" can be identified by name rather than a static numeric index.  Given that tables adjust dynamically to the data, no counts are required to determine the length of the column.

 

The key function is FILTER which will return all the records that match the criterion

= FILTER( Table1, Table1[field]="Unknown"} )

 

The advantage of names is as great when it comes to VBA.  A named field can be block-read into a variant array and then the looping is in memory rather than requiring continual exchanges between the VBA environment and the worksheet.  If the column changes, the Name moves with it, so the code is more robust.

@gms4b

 

It's easy, just copy the code in a new button in the Diluted sheet, and change the sheet names in it.

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
    
    Dim i As Integer
    i = 0
    
    Sheets("Diluted").Activate
    Dim columnNamesArray() As Variant
    columnNamesArray = Array("Sample Type", "Rack Type")
    
    Dim columnName As Variant
    For Each columnName In columnNamesArray
     
    Dim columnNumber As Integer
    columnNumber = Cells.Find(What:=columnName, After:=Range("A1"), LookIn:=xlFormulas, _
                   LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                   MatchCase:=False, SearchFormat:=False).Column
                   
    Cells(1, columnNumber).EntireColumn.Copy
    
    Sheets("DilutedPLUS").Activate
    Sheets("DilutedPLUS").Range("A1").Select
    ActiveCell.Offset(0, i).Select
    ActiveSheet.Paste
    i = i + 1
    Next columnName

ActiveSheet.Range("A1").Activate
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

@Haytham Amairah 

 

Yes, yes, lol. I was thinking the same thing after I left work yesterday. I'm sure there's a way to combine it together into some sort of loop, but this is easier. I also created a 4th command button which sequentially runs each of the first three scripts! In the end, I think it'll be nice to have the option to run things separately....or just run everything. 

 

Thanks again!

 

Greg

@gms4b

 

In my opinion, an embedded button on each worksheet is not a good idea!

You can run the code from the Quick Access Toolbar or from a new ribbon tab.

Or you can place the buttons in one worksheet as follows:

Run.png

 

Also, grouping all the process code in one Sub is also not a good idea!

You can instead separate them in three Subs so that each Sub handle one part of the automation.

Then move all Subs in a new generic module.

 

Then create a sub called (Main) and call the other subs in it.

This makes the code more readable and maintainable.

 

This is the full Module1 code including all Subs.

 

Sub Main()
    Call FilterData
    Call MoveToUndilutedPLUS
    Call MoveToDilutedPLUS
End Sub

Sub FilterData()
    Application.ScreenUpdating = False
    On Error Resume Next
    
    Worksheets("Raw Data").Activate
    
    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
        
    Sheets("Raw Data").Range("A1:CZ1").Copy Destination:=Sheets("Undiluted").Range("A1:CZ1")
    Sheets("Raw Data").Range("A1:CZ1").Copy Destination:=Sheets("Diluted").Range("A1:CZ1")
    
    Next
    
    Worksheets("Raw Data").Activate
    Worksheets("Raw Data").Range("A1").Select
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    On Error GoTo 0
End Sub

Sub MoveToUndilutedPLUS()
    Application.ScreenUpdating = False
    On Error Resume Next
    
    Dim i As Integer
    i = 0
    
    Sheets("Undiluted").Activate
    Dim columnNamesArray() As Variant
    columnNamesArray = Array("Analyte Peak Name", "Sample Type", "Rack Type", "Vial Position")
    
    Dim columnName As Variant
    For Each columnName In columnNamesArray
    Sheets("Undiluted").Activate
        
    Dim columnNumber As Integer
    columnNumber = Cells.Find(What:=columnName, After:=Range("A1"), LookIn:=xlFormulas, _
                   LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                   MatchCase:=False, SearchFormat:=False).Column
                   
    Cells(1, columnNumber).EntireColumn.Copy
    
    Sheets("UndilutedPLUS").Activate
    Sheets("UndilutedPLUS").Range("A1").Select
    ActiveCell.Offset(0, i).Select
    ActiveSheet.Paste
    i = i + 1
    Next columnName
    
    Sheets("UndilutedPLUS").Range("A1").Select
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    On Error GoTo 0
End Sub

Sub MoveToDilutedPLUS()
    Application.ScreenUpdating = False
    On Error Resume Next
    
    Dim i As Integer
    i = 0
    
    Sheets("Diluted").Activate
    Dim columnNamesArray() As Variant
    columnNamesArray = Array("Sample Type", "Rack Type")
    
    Dim columnName As Variant
    For Each columnName In columnNamesArray
    Sheets("Diluted").Activate
     
    Dim columnNumber As Integer
    columnNumber = Cells.Find(What:=columnName, After:=Range("A1"), LookIn:=xlFormulas, _
                   LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                   MatchCase:=False, SearchFormat:=False).Column
                   
    Cells(1, columnNumber).EntireColumn.Copy
    
    Sheets("DilutedPLUS").Activate
    Sheets("DilutedPLUS").Range("A1").Select
    ActiveCell.Offset(0, i).Select
    ActiveSheet.Paste
    i = i + 1
    Next columnName
    
    Sheets("DilutedPLUS").Range("A1").Select
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    On Error GoTo 0
End Sub

 

 

This also makes the code reusable as the embedded buttons don't duplicate the same code, it just reuses it or recalls it.

 

This is the embedded buttons code behind the Run sheet:

Code Behind.png

 

Please find all that in the attached worksheet.

Regards