Aug 05 2019 08:24 AM - edited Aug 05 2019 08:28 AM
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
Aug 05 2019 09:15 AM
Hi,
You can do this by a simple algorithm:
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
Aug 05 2019 11:23 AM
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
Aug 05 2019 11:32 AM
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!
Aug 05 2019 12:19 PM - edited Aug 06 2019 05:49 AM
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
Aug 06 2019 06:18 AM
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
Aug 06 2019 09:25 AM
Hi,
Sorry about the late reply as I was too busy!
Aug 06 2019 10:10 AM
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
Aug 06 2019 11:55 AM - edited Aug 06 2019 12:00 PM
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
Aug 06 2019 08:16 PM
Hi,
As I understand, you want to move specific entire columns to other sheets, not some rows based on a condition?
Aug 07 2019 06:10 AM
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
Aug 07 2019 08:51 AM
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
Aug 07 2019 11:00 AM
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
Aug 07 2019 12:04 PM
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
Aug 07 2019 01:10 PM - edited Aug 07 2019 02:04 PM
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
Aug 07 2019 02:27 PM
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
Aug 07 2019 02:28 PM
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.
Aug 07 2019 08:25 PM
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
Aug 08 2019 06:17 AM
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
Aug 08 2019 08:40 AM - edited Aug 08 2019 08:46 AM
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:
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:
Please find all that in the attached worksheet.
Regards