Finding values in a number of columns using VBA

Question

I am relatively new to excel vba, but I am looking for some advice about creating a macro that I can run over a number of worksheets in a workbook.

The advice I am looking for is to take 3 columns where I can find certain values in those columns. Where a row has a value in each of those 3 columns that is met to save those rows along with all the column headings into a new worksheet in the same workbook. So, if I have 10 worksheets in my workbook and run the macro, I need to end up with 20 worksheets.

Can anyone help me?

You can start experimenting with .Find :) See this link. siddharthrout.wordpress.com/2011/07/14/… Once you get that part right start recording a macro to move values between sheets and then combine the 2 codes :) Give it a try and then if you get stuck, simply post back... — Siddharth Rout

Scott Holtzman Scott Holtzman · Accepted Answer · 2012-05-10T21:42:14

Since you are new to VBA, I'm giving you some code. Lord knows I had plenty of help when I was new. Check this out. I am not sure how you are going to pass which values to look for, but this should give you a great start.

Sub find3_makesheet()

Dim strValue As String
Dim wks As Worksheet
Dim rng1 As Range, rng2 As Range, rng3 As Range

strValue = "myValue"

For Each wks In Worksheets

    With wks

        If Not .Columns(1).Find(strValue, lookat:=xlWhole) Is Nothing Then Set rng1 = .Columns(1).Find(strValue, lookat:=xlWhole)
        If Not .Columns(2).Find(strValue, lookat:=xlWhole) Is Nothing Then Set rng2 = .Columns(2).Find(strValue, lookat:=xlWhole)
        If Not .Columns(2).Find(strValue, lookat:=xlWhole) Is Nothing Then Set rng3 = .Columns(2).Find(strValue, lookat:=xlWhole)

        If Not rng1 Is Nothing And Not rng2 Is Nothing And Not rng3 Is Nothing Then
            ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
            Set wksCopyTo = ActiveSheet
            .Rows(1).EntireRow.Copy wksCopyTo.Rows(1)
            rng1.EntireRow.Copy wksCopyTo.Rows(2)
            rng2.EntireRow.Copy wksCopyTo.Rows(3)
            rng3.EntireRow.Copy wksCopyTo.Rows(4)
        End If

    End With

    Set rng1 = Nothing
    Set rng2 = Nothing
    Set rng3 = Nothing
Next

End Sub

Finding values in a number of columns using VBA

1 Answers