modify VBA code to include dynamic columns instead of static

gms4b

It seems to be a rough process and needs a lot of work!
Maybe I don't have enough time to look at it!
I'm sorry!
But apparently, the solution through the code would not be better, because in the code we would consider using the same lookup functions in the worksheet as in the example below:
Application.WorksheetFunction.VLookup

So I advise you to consider other solutions suggested by PeterBartholomew1.

Or stick with the analysis you've already done using VLOOKUP.

Regards

@Haytham Amairah 

Ok...I've been adding to the code that you cleaned up. With the new code I haven't created buttons...I've just added more subs to Module1 and called them to Main like you did. For most everything new I simply recorded a macro and copied that code to Module1. The columns are static at this point, which makes it easier. I usually did some sort of modification to make it work (added "& LastRow" to autofill down to the last entry in the column, for example). I tested the new code by hitting F8 through each line to make sure it does what it should.

I have one crucial, and (maybe) tricky bit of code to write...and I have no idea how to do it...or which would be easiest. Big picture: I run biological samples at work. Initially I run the samples "undiluted" and see if the data falls within a certain range. If not, then the samples are run again "diluted". Sometimes they still don't fall within the range and are diluted again. At some point, regardless of being within a range, the data is reported. 

In the "UndilutedPLUS" and "DilutedPLUS" tabs I've added many columns. The important ones to know: 

ColumnA: this is a helper column....it gives the sample a unique ID (i.e for VLOOKUP)

ColumnM: this says whether the sample is good (1) or not (0)

So, let me know if this is possible:

1) Copy Column A (helper column) from the "UndilutedPLUS" sheet to the "Final Data" sheet. This gives a definitive list of all samples (since each sample is run undiluted). Now we need data from the "UndilutedPLUS" or "DilutedPLUS" sheets. 

2) Use VLOOKUP? (or anything else?) to look for the corresponding row of data in "UndilutedPLUS" (using the entry in the helper column (ColumnA)) and

if Column M=1 then copy the data to "Final Data." (and you're done)

if Column M=0 then next

3) Look for the corresponding row of data in the "DilutedPLUS" sheet and

if Column M=1 then copy the row of data to "Final Data" (and you're done)

if Column M=0 then next

4) Look for the corresponding row of data in the "DilutedPLUS" sheet and

if Column M=0 then copy the row of data to "Final Data" (and you're done)

I have a way to do this using VLOOKUP for each individual cell in the spreadsheet. It works, but is clunky. It uses 3 nested "if" statements with VLOOKUPs to go through the statements above for each cell. Then it gets modified for each column and then filled down to the last row in the "Final Data" sheet. It's doable, but not pretty.

I hope this isn't too tough. I feel that doing complicated things with formulas becomes unnecessarily difficult whereas a good script can do it more easily. I'm just giving you extra detail in case you need it. 

So, I have a small data set in the attached document.

*Sample A1 should get moved first thing and data reported because the value in "Undiluted Plus" in column M=1.

*Sample B1, shows Column M=0 in the "UndilutedPLUS" sheet so you'd go the the "DilutedPLUS" sheet where one dilution gave Column M=0 but the second one gave, Column M=1...so that data will be reported. 

*Sample C1, similar to B1 but both dilutions gave Column M=0, so the second one will be reported. 

The last tab in the spreadsheet is "Final Data Example" which shows what the final result should look like. Good luck if you feel like taking this on. I'll be on vacation next will but will bring my computer in case you have a chance to work on it. 

Cheers and thanks,

Greg

Haytham Amairah 

Thank you for the advice. Good to know about not grouping everything into one sub. What you described I think is basically where I'm at now. I added a 4th Sub (CommandButton) which sequentially runs each of the 3 subs so far. I can just modify things in the future as I add more. I can see how your code is certainly more elegant. I'll look into that file. Thank you so much!

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

Private Sub CommandButton4_Click()
CommandButton1_Click
CommandButton2_Click
CommandButton3_Click
End Sub

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

gms4b

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

You can run the code from the https://www.excel-easy.com/vba/examples/add-a-macro-to-the-toolbar.html or from https://www.youtube.com/watch?v=dmdolFcS-fI 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

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

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 

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

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

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