Forum Discussion
modify VBA code to include dynamic columns instead of static
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
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
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!
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 Longa = 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 IfIf ((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
NextApplication.CutCopyMode = False
ThisWorkbook.Worksheets("Raw Data").Cells(1, 1).Select
Application.ScreenUpdating = TrueEnd Sub
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
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 Longa = 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
NextApplication.CutCopyMode = False
ThisWorkbook.Worksheets("Raw Data").Cells(1, 1).Select
Application.ScreenUpdating = TrueEnd Sub