VBA macro coding, finding data in multiple colums

[Jaymck]

Hi guys,

I am looking to do the following:

Have a button that when selected in another page, will find data across two different coloums in a different page, then copy and paste that data into another after wiping the page that the data is being copied into (as it will be used again for another search).

At the moment I have coding that will do that for one coloum only and works, however I now need it to search across two!

This is the coding I am currently using:

Sub BNEGPU()
' BNEute Macro
Dim LPaste As Integer
Application.ScreenUpdating = False
LPaste = 8
Sheets("Report").Select
Range("O2:P7").Select
Application.CutCopyMode = False
Selection.ClearContents

Sheets("Report").Select
Range("A8:M1000").Select
Application.CutCopyMode = False
Selection.ClearContents

Sheets("MasterList").Select
Sheets("MasterList").Select
RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
For i = 1 To RowCount
Range("C" & i).Select
check_value = ActiveCell
If check_value = "GPU" Or check_value = "gpu" Or check_value = "Gpu" Or check_value = "g p u" Or check_value = "Ground Power Unit" Or check_value = "ground power unit" Or check_value = "Ground power unit" Or check_value = "GPUS" Or check_value = "GPUs" Or check_value = "GROUND POWER UNIT" Then
ActiveCell.EntireRow.Copy

Sheets("Report").Select
RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
Range("a" & RowCount + 1).Select
Rows(CStr(LPaste) & ":" & CStr(LPaste)).Select

Selection.PasteSpecial Paste:=xlPasteValues

LPaste = LPaste + 1

Sheets("MasterList").Select

End If
Next

Sheets("Report").Select
Range("N8").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISBLANK(RC[-1]),"""",RANK(RC[-1],R8C13:R151C13,1))"
Range("N8").Select
Selection.AutoFill Destination:=Range("N8:N1000"), Type:=xlFillDefault

Sheets("Risk Assessments").Select
Range("M14").Select
Selection.Copy
Sheets("Report").Select
Range("O2").Select
ActiveSheet.Paste

Sheets("Risk Assessments").Select
Range("M7").Select
Selection.Copy
Sheets("Report").Select
Range("P2").Select
ActiveSheet.Paste

Range("I1").Select
Application.ScreenUpdating = True
End Sub


Can anyone help!!

Thanks!

 

[Hamburgler]

I haven't studied all of your code, but it looks like the following lines are searching all cells in column C and if one of the "GPU" values are found then the whole row is copied across to the other sheet.

For i = 1 To RowCount
    Range("C" & i).Select
    check_value = ActiveCell
    If check_value = "GPU" Or check_value = "gpu" Or check_value = "Gpu" Or check_value = "g p u" Or check_value = "Ground Power Unit" Or check_value = "ground power unit" Or check_value = "Ground power unit" Or check_value = "GPUS" Or check_value = "GPUs" Or check_value = "GROUND POWER UNIT" Then
        ActiveCell.EntireRow.Copy
        Sheets("Report").Select
        RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
        Range("a" & RowCount + 1).Select
        Rows(CStr(LPaste) & ":" & CStr(LPaste)).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        LPaste = LPaste + 1
        Sheets("MasterList").Select
    End If
Next

A very quick and dirty solution MAY be to repeat the same code again for the additional column/s, for example in the code below column D is searched as well. Please be sure to test it on a COPY of your actual file.

For i = 1 To RowCount
    Range("C" & i).Select
    check_value = ActiveCell
    If check_value = "GPU" Or check_value = "gpu" Or check_value = "Gpu" Or check_value = "g p u" Or check_value = "Ground Power Unit" Or check_value = "ground power unit" Or check_value = "Ground power unit" Or check_value = "GPUS" Or check_value = "GPUs" Or check_value = "GROUND POWER UNIT" Then
        ActiveCell.EntireRow.Copy
        Sheets("Report").Select
        RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
        Range("a" & RowCount + 1).Select
        Rows(CStr(LPaste) & ":" & CStr(LPaste)).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        LPaste = LPaste + 1
        Sheets("MasterList").Select
    End If

    Range("D" & i).Select
    check_value = ActiveCell    
    If check_value = "GPU" Or check_value = "gpu" Or check_value = "Gpu" Or check_value = "g p u" Or check_value = "Ground Power Unit" Or check_value = "ground power unit" Or check_value = "Ground power unit" Or check_value = "GPUS" Or check_value = "GPUs" Or check_value = "GROUND POWER UNIT" Then
        ActiveCell.EntireRow.Copy
        Sheets("Report").Select
        RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
        Range("a" & RowCount + 1).Select
        Rows(CStr(LPaste) & ":" & CStr(LPaste)).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        LPaste = LPaste + 1
        Sheets("MasterList").Select
    End If
Next i

 

[Jaymck]

Hi Hamburgler,

Thanks for the prompt response.

Sorry, I should have mentioned earlier that I need the code to search for the two items then copy the entire row into the next report.

I'll give this a go then get back to you!

 

[Hamburgler]

This one checks for GPU values in both columns C and D and only copies the row if a value is found in both. I changed the code to check lower case of the cell values (without selecting) so you don't have to list all different case versions of the text. Hopefully it works for you.

For i = 1 To RowCount
    C_Value = Trim(LCase(Cells(3, i).Value))
    D_Value = Trim(LCase(Cells(4, i).Value))
    If C_Value = "gpu" Or C_Value = "g p u" Or C_Value = "gpus" Or C_Value = "ground power unit" Then
        If D_Value = "gpu" Or D_Value = "gpu" Or D_Value = "g p u" Or D_Value = "gpus" Or D_Value = "ground power unit" Then
            Cells(3, i).Value.EntireRow.Copy
            Sheets("Report").Select
            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
            Range("a" & RowCount + 1).Select
            Rows(CStr(LPaste) & ":" & CStr(LPaste)).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            LPaste = LPaste + 1
            Sheets("MasterList").Select
        End If
    End If
Next i

Also note that using ".Select" is virtually never needed.

This

Sheets("Risk Assessments").Select
Range("M7").Select
Selection.Copy
Sheets("Report").Select
Range("P2").Select
ActiveSheet.Paste

Can be replaced with something like this

Sheets("Risk Assessments").Range("M7").Copy Sheets("Report").Range("P2")

 

[Jaymck]

Hi Hamburgler

I have just tried the code and I cant seem to get it working.

To give you a bit of context, I am trying to get the coding to look in coloums A and C. In A is where the difference will be. For example, I want a macro for ADL, MEL, BNE and SYD all of which have GPUs in them.

So I need four macros that will all search under the same master list looking for the GPUs that are in their port only. Like if I clicked on the macro for BNE (below) I want it to search through the master list for all BNE items then narrow them down to the GPUs only.

The current code (that at the moment is working but not finding anything) is below:

[TABLE="width: 84"]
<TBODY>[TR]
[TD]Sub BNEGPU()
' BNEute Macro
Dim LPaste As Integer
Application.ScreenUpdating = False
LPaste = 8
Sheets("Report").Select
Range("O2:P7").Select
Application.CutCopyMode = False
Selection.ClearContents

Sheets("Report").Select
Range("A8:M1000").Select
Application.CutCopyMode = False
Selection.ClearContents

Sheets("MasterList").Select
For i = 1 To RowCount
C_Value = Trim(LCase(Cells(3, i).Value))
A_Value = Trim(LCase(Cells(4, i).Value))
If A_Value = "BNE" Then
If C_Value = "gpu" Or C_Value = "g p u" Or C_Value = "gpus" Or C_Value = "ground power unit" Or C_Value = "GPU" Then
Cells(3, i).Value.EntireRow.Copy
Sheets("Report").Select
RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
Range("a" & RowCount + 1).Select
Rows(CStr(LPaste) & ":" & CStr(LPaste)).Select
Selection.PasteSpecial Paste:=xlPasteValues
LPaste = LPaste + 1
Sheets("MasterList").Select
End If
End If
Next i

Sheets("Report").Select
Range("N8").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISBLANK(RC[-1]),"""",RANK(RC[-1],R8C13:R151C13,1))"
Range("N8").Select
Selection.AutoFill Destination:=Range("N8:N1000"), Type:=xlFillDefault

Sheets("Risk Assessments").Select
Range("M14").Select
Selection.Copy
Sheets("Report").Select
Range("O2").Select
ActiveSheet.Paste

Sheets("Risk Assessments").Select
Range("M7").Select
Selection.Copy
Sheets("Report").Select
Range("P2").Select
ActiveSheet.Paste

Range("I1").Select
Application.ScreenUpdating = True
End Sub



I will be using the same coding for MEL SYD and ADL also and will use them for other items too, once I get the right coding.

Thank you so much for all your help! I'm very stuck!
[/TD]
[/TR]
</TBODY><COLGROUP><COL></COLGROUP>[/TABLE]