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

@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

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

 

clipboard_image_0.png

@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

 

 

 

@gms4b 

I am still somewhat puzzled as to the reason you turn so readily to VBA for the analysis.  Excel has a huge amount of built-in functionality to support filtering, both as manual operations and automatic, using formulas,

 

I ran the code in "Example with VBA4.xlsm" this morning and it took 1min20sec to produce 630 rows for 'undiluted' and a further 30 on the 'diluted' sheet.  I am sure there is plenty of room for speed optimisation of the code but I went on to compare that time with that of a formula-based approach.

 

I happened to be using a machine with Office 365 loaded so, having converted the source data to a table, I used a modern dynamic array formula to extract the required records.  The formulas

= FILTER( RawData,

((RawData[Sample Type]="Unknown") +

(RawData[Sample Type]="Quality Control")) *

(RawData[Dilution Factor]=1) )

and

= FILTER( RawData,

((RawData[Sample Type]="Unknown") +

(RawData[Sample Type]="Quality Control")) *

(RawData[Dilution Factor]>1) )

each took 0.1sec to run and gave identical output.

 

p.s. Other options would include running the Advanced Filter from code (any version of Excel) or to use Power Query (Office 2010 with add-in, native 2016 and on).

 

I have now attached a copy of the file with your early VBA, with Power Query and with Dynamic Array formulas.  The last only works with the most up-to-date versions of Office365.

@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 @Peter Bartholomew.

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

 

Regards

@Peter Bartholomew 

 

Thanks Peter. I'll start to look into this. In the end, the whole process is:

- dividing Unknown and Quality Control samples between diluted and undiluted groups (Then get rid of columns that I don't need)

- Adding some columns to each of these sets to do some math do determine if the samples are in a range

- Then a VLOOKUP to compare samples in the diluted and undiluted groups and choose the proper one for final data. 

 

This has been a very manual process not just for me, but my teammates. I wanted to make a way for people to simply add in all the raw data into the first tab of a spreadsheet, press a button, and get final data. So, that's why I thought VBA would be a good way to automate the whole process. 

 

If i can find a way to do the filtering (as you suggest) and replace the first part of the code, then that sounds like a good idea. As you mentioned.....it can be rather slow. And, its possible that 1000's of rows of data could be in a set. 

 

Thanks,

 

Greg

 

 

@gms4b 

Do you and any colleagues that need to manipulate the results have Office 365 and can you set it to monthly updates?  The array methods I have used have only come out in the latest releases of Excel and, though it would be possible to transfer the data using INDEX it would lack elegance. 

Removing columns could be achieved by being more selective as to the columns brought through in the first place, even down to the level of bring key columns across individually within the downstream calculation.

@Peter Bartholomew 

 

Yes, we all have Office 365 ProPlus...with automatic updates. 

 

I did some work last week to include filtering in the code....and it worked well! I did it with a latter part of the script though, not the first part that you've looked at. I'm not sure its what you envisioned...but it worked (just using the simple "sort" feature). Basically, not being a programmer, I simply recorded a macro with what and where I needed to filter and copied and pasted the rows between sheets. I then took the code from the macro and inserted into my main code. I needed to modify it a bit to always go down the the last row (since they will always be changing), but that worked well (even though you select a whole column while recording a macro it inserts a number for the last row). But, yeah, it worked.

 

Since it worked well toward the end of the code I'll be going back and doing that eventually for the first part of the code....because, as you mentioned, that first part of the code is quite time consuming. And my data sets will only get larger.

 

Unfortunately, the raw data from our instruments exports columns into different locations each time. Haytham Amairah wrote a nice bit of code (below) for me to move only columns that are included in the array to a new sheet. I'll likely change the code to run this first, then do sorting when the columns are static. 


Greg

 

 

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

Sub MoveToUndilutedPLUS()
Application.ScreenUpdating = False
On Error Resume Next

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", "Calculated Concentration (", "Analyte Concentration", "Accuracy")

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("B1").Select
ActiveCell.Offset(0, i).Select
ActiveSheet.Paste
i = i + 1
Next columnName

@gms4b 

Rather than searching for the column headers as text, I would recommend converting the raw data to a Table and selecting the columns you require by name.  The formula I used to consolidate the columns into a single array that I could filter is a bit of a pig but it appears to work.  I implemented it as a Named Formula 'SelectedData' that could then be filtered as before:

= CHOOSE( {1,2,3,4,5,6,7,8,9},

RawData[Sample Type],

RawData[Sample Name],

RawData[Acquisition Date],

RawData[File Name],

RawData[Dilution Factor],

RawData[Analyte Peak Name],

RawData[Calculated Concentration (ng/mL)],

RawData[Analyte Concentration (ng/mL)],

RawData[Accuracy (%)] )

 

I guess both the VBA and the formulae must present something of a problem for you to follow.  I tend to lose or simply bewilder spreadsheet users when I describe the practice of addressing data by location (A1 or, in VBA, Cells(1,1)) as an abomination that has no place in serious model building.  For me, the name is meaningful whilst the location is mere chance and will change as data is rearranged within the workbook.  In your case, it simply doesn't matter in what order the columns are placed as long as they are named consistently.

 

Please note that most users would vehemently disagree with the underlined statement, they would see the A1 notation as integral to the concept of a spreadsheet.

This tackles the same problem but with Power Query.

Again, the columns are referenced by name so column shuffling or even moving the table to another sheet should make no difference.

@Haytham Amairah 

 

Thanks so much again for helping me! Its really been great working on my code...and you were a great help starting out. 

 

I have 2 questions about the code that you wrote for me.

 

1) is there a way to start the searching on Range "A1" instead of After:=Range("A1")? I guess it loops back to A1 at the end, but there are other columns that it will sometimes pick up on and consider a match before it gets back to column A. Right now, I've been coding in a line where is simply adds a column (i.e. to make column A into column B)...and that seems to work. Wondering if there is a better way.

2) more importantly, is there a way to have the loop NOT copy a column over if there isn't a match? Right now, for instance, the column "weight adj" might not be in a data set....yet, the code will choose the closest match (usually "Use record", since its closeby) and copy that to "Truncated Data". But, that can cause issues later on.

 

Is there a way, maybe, to set up a second loop to look for that term....and if is isn't there, then don't copy?

 

Thanks so much!

 

Greg

 

 

Sub TruncatedData()

    Application.ScreenUpdating = False
    On Error Resume Next
    
    Dim i As Integer
    i = 0
    
    Sheets("Raw Data").Activate
    
Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove    


    Dim columnNamesArray() As Variant
    columnNamesArray = Array("Sample Type", "Sample Name", "Acquisition Date", "File Name", "Dilution Factor", "Analyte Peak Name", "Calculated Concentration (", "Analyte Concentration", "Accuracy", "Use Record", "weight adj")
    
    Dim columnName As Variant
    
    For Each columnName In columnNamesArray
    Sheets("Raw Data").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("Truncated Data").Activate
    Sheets("Truncated Data").Range("B1").Select
    ActiveCell.Offset(0, i).Select
    ActiveSheet.Paste
    i = i + 1
    Next columnName

End sub

 

@Haytham Amairah 

 

I think I solved my problems! Code below....

 

I realized that if the find function couldn't "find" the item, then it would error, but the "on error resume next" line would just go to the next line and copy the previously used column number. I changed the on error line to "on error goto jump:" where the "jump:" jumps to "next columnname" which skips copying the previous column. 

 

I also just deleted the "After:=Range("A1")" term in the search parameters. I believe this then starts the search in A1....which is fine for what I need.

 

Greg

 

 

 

Sub TruncatedData()
    Application.ScreenUpdating = False
    On Error GoTo jump:
        
    Dim i As Integer
    i = 0
    
    Sheets("Raw Data").Activate
     
    Dim columnNamesArray() As Variant
    columnNamesArray = Array("Sample Type", "Sample Name", "Acquisition Date", "File Name", "Dilution Factor", "Analyte Peak Name", "Calculated Concentration (", "Analyte Concentration", "Accuracy", "Use Record", "weight adj")
    
    Dim columnName As Variant
    
    For Each columnName In columnNamesArray
    Sheets("Raw Data").Activate
        
    Dim columnNumber As Integer

    columnNumber = Cells.Find(What:=columnName, LookIn:=xlFormulas, _
                   Lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                   MatchCase:=False, SearchFormat:=False).Column
                  
    Cells(1, columnNumber).EntireColumn.Copy
    
    Sheets("Truncated Data").Activate
    Sheets("Truncated Data").Range("B1").Select
    ActiveCell.Offset(0, i).Select
    ActiveSheet.Paste
    i = i + 1
jump: Next columnName
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub