Identify single row in vba

[satya12]

Hi All,

I am having 2 workbooks, in that workbook 1 after filtered 2 or 3 rows visible, in that i have to write the code in those visible cells if G col contains "apple" in the sentence , select that row and copy D and E col paste another sheet, if G col Doesn't contain apple in the text , select that row copy D and E col paste another sheet. i used one code but it is copying all visible cells.

Sub Rights()
    For i = 2 To 5
       'Autofill
        Worksheets("sheet6").Activate
        If InStr(Range("E" & i).Value, "Apple") > 0 Then
            ActiveSheet.Range("D2:D").SpecialCells(xlCellTypeVisible).Copy
            Worksheets("sheet3").Activate
            ActiveSheet.Range("C" & i).PasteSpecial Paste:=xlPasteValues
            
        Else
            ActiveSheet.Range("D2:D").SpecialCells(xlCellTypeVisible).Copy
            Worksheets("sheet3").Activate
            ActiveSheet.Range("C" & i).PasteSpecial Paste:=xlPasteValues
           
            Application.CutCopyMode = False
            
            
        End If
    Next i
End Sub

 

[HaHoBe]

Hi satya12,

by using

ActiveSheet.Range("D2:D").SpecialCells(xlCellTypeVisible).Copy

there are two errors showing. The range needs an argument for each single member with Letter and Number, and using the command SpecialCells(xlCellTypeVisible). will just copy the whole area.

You would need to either use a second filter on Column E or step through the range of the visible cells.

And I wonder why you would copy the same cell to the same sheet no matter if Apple is found or not. And I´m not so sure why you will only check rows from 2 to 5... You may need to alter i from 2 as it is in the code to 1 if you want to include the first line of filtered data

Code may look like this:

Sub Rights_mod()
  Dim rngCell As Range
  Dim i As Integer
  
   i = 2
  
  'Autofill
  With Worksheets("sheet6")
    For Each rngCell In .Range("E2", .Cells(.Rows.Count, "E").End(xlUp)).SpecialCells(xlCellTypeVisible)
      If i < 6 Then
        If InStr(rngCell.Value, "Apple") > 0 Then
          Worksheets("sheet3").Range("C" & i).Value = rngCell.Offset(0, -1).Value
        Else
          Worksheets("sheet3").Range("C" & i).Value = rngCell.Offset(0, -1).Value
        End If
        i = i + 1
      End If
    Next rngCell
  End With
End Sub

Ciao,
Holger

 

[satya12]

@HaHoBe , thanks for your reply.
Why i used i from 2 to 5 is because its having another part before this while i am testing first 5 rows that's why i just put it in code.
i tried your code but i am getting error for copy and pasting, and i modified the code with excel workbook 1 and workbook 2 with sheet name.
i will explain my module to you we are having 2 excel files. we have to copy row by row information from excel 1 to new macro , after copy the required columns it will filter the excel 2 using excel 1 columns , after filtering 3 or 4 rows are visible , in the visible cells if condition is met select the row any copy some cells in that row paste it into another excel this is my module.
and i don't need i values in the code because starting of the code will start from for loop so i dont need i values .
simply i will tell if condition is met in the visible rows , select the particular row copy the cell values which i want and paste it into another workbook.

Sub Autofill()
        Dim rngcell As Range
        Windows("Copy of HP Cheat Sheet.xlsm").Activate
        With Worksheets("Template")
            For Each rngcell In .Range("G2", .Cells(.Rows.Count, "E").End(xlUp)).SpecialCells(xlCellTypeVisible)
            If i < 6 Then
                If InStr(rngcell.Value, "<100") > 0 Then
                    Windows("Output file.xlsm").Activate
                    Worksheets("Macro").Range("C" & i).Value = rngcell.Offset(0, -1).Value
                Else
                     Windows("Output file.xlsm").Activate
                    Worksheets("Macro").Range("C" & i).Value = rngcell.Offset(0, -1).Value
                End If
                    i = i + 1
            End If
        Next rngcell
        End With
End Sub

 

[HaHoBe]

Hi satya12,

you state that there is an error showing up in my code. Do you mind to clarify which error that is?

Again: you check if a value is present or not but copy the very same range - I altered the code to list the fitting items in Column C and the other ones in Column D.

The code is untested so it may throw an exception:

Sub Autofill_mod211028()
        Dim rngcell As Range
        Dim wbHP_Cheat As Workbook
        Dim wsTemp As Worksheet
        Dim wbOutput As Workbook
        Dim wsMacro As Worksheet
       
        Set wbHP_Cheat = Workbooks("Copy of HP Cheat Sheet.xlsm")
        Set wsTemp = wbHP_Cheat.Sheets("Template")
        Set wbOutput = Workbooks("Output file.xlsm")
        Set wsMacro = wbOutput.Sheets("Macro")
       
        With wsTemp
          For Each rngcell In .Range("G2", .Cells(.Rows.Count, "E").End(xlUp)).SpecialCells(xlCellTypeVisible)
            If InStr(rngcell.Value, "<100") > 0 Then
              wsMacro.Range("C" & wsMacro.Cells(wsMacro.Rows.Count, "C").End(xlUp).Row + 1).Value = rngcell.Offset(0, -1).Value
            Else
              'changed the destination from Column C to Column D
              wsMacro.Range("D" & wsMacro.Cells(wsMacro.Rows.Count, "D").End(xlUp).Row + 1).Value = rngcell.Offset(0, -1).Value
            End If
          Next rngcell
        End With
End Sub

Ciao,
Holger

 

[satya12]

@HaHoBe ,
Thank you so much for your help , this code works fine.
But how can i use this code because which we are copying the values it must be paste on the row which row macro checking if macro checking 3rd row it will paste the value in the 3rd row columns c or d like that. i am posting the code which i mentioned the range also 1st workbook 1 will activate and count the row in that i mentioned for i = 2 to a means count of workbook1 rows ,
copy the PL value from workbook 1 and paste it into macro
then autofill.

Sub Autofill()
Windows("HP Price book.xlsx").Activate
a = Worksheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row

    For i = 2 To a
        'PL Number
        Windows("HP INC Price book.xlsx").Activate
        Worksheets("Sheet1").Range("D" & i).Copy
        Windows("Output file.xlsm").Activate
        Worksheets("Macro").Range("A" & i).Select
        ActiveSheet.Paste
        
        'Autofill
        Dim rngcell As Range
        Dim wbHP_Cheat As Workbook
        Dim wsTemp As Worksheet
        Dim wbOutput As Workbook
        Dim wsMacro As Worksheet
       
        Set wbHP_Cheat = Workbooks("Copy of HP Cheat Sheet.xlsm")
        Set wsTemp = wbHP_Cheat.Sheets("Template")
        Set wbOutput = Workbooks("Output file.xlsm")
        Set wsMacro = wbOutput.Sheets("Macro")
       
        With wsTemp
          For Each rngcell In .Range("G2", .Cells(.Rows.Count, "G").End(xlUp)).SpecialCells(xlCellTypeVisible)
            If InStr(rngcell.Value, "<100") > 0 Then
              wsMacro.Range("C" & wsMacro.Cells(wsMacro.Rows.Count, "C").End(xlUp).Row + 1).Value = rngcell.Offset(0, -1).Value
            Else
              'changed the destination from Column C to Column D
              wsMacro.Range("D" & wsMacro.Cells(wsMacro.Rows.Count, "D").End(xlUp).Row + 1).Value = rngcell.Offset(0, -1).Value
            End If
          Next rngcell
        End With
    Next i
End Sub

 

[HaHoBe]

Hi satya12,

if you want to rely on the row which is checked you may use rngCell.Row for getting that number like

wsMacro.Range("C" & rngCell.Row).Value = rngcell.Offset(0, -1).Value

and

wsMacro.Range("D" & rngCell.Row).Value = rngcell.Offset(0, -1).Value

Ciao,
Holger

 

[satya12]

@HaHoBe , Thanks for your help.
I changed the code as your advice, but it is pasting the values which row they copied and paste it into the same row
like if excel 1 is the where we are checking the text , if 11 and 14 cells are visible in the sheet,
if text <100 was found copy the c cell value and paste it into macro 11th row c col
not found paste the D cell value into macro 14th row D col
but in my code we are pasting PL value in the second line by line code was executing , if text for in that excel1 copy the value in the 2nd row C col .
please help me.

Sub Autofill()
    Windows("HP INC Price book.xlsx").Activate
    a = Worksheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row

    For i = 2 To 4
        'PL Number
        Windows("HP INC Price book.xlsx").Activate
        Worksheets("Sheet1").Range("D" & i).Copy
        Windows("Output file.xlsm").Activate
        Worksheets("Macro").Range("A" & i).Select
        ActiveSheet.Paste
        
        'Autofill
        Dim rngcell As Range
        Dim wbHP_Cheat As Workbook
        Dim wsTemp As Worksheet
        Dim wbOutput As Workbook
        Dim wsMacro As Worksheet
       
        Set wbHP_Cheat = Workbooks("Copy of HP INC Cheat Sheet.xlsm")
        Set wsTemp = wbHP_Cheat.Sheets("Template")
        Set wbOutput = Workbooks("Output file.xlsm")
        Set wsMacro = wbOutput.Sheets("Macro")
       
        With wsTemp
          For Each rngcell In .Range("G2", .Cells(.Rows.Count, "G").End(xlUp)).SpecialCells(xlCellTypeVisible)
            If InStr(rngcell.Value, "<100") > 0 Then
              wsMacro.Range("C" & rngcell.Row).Value = rngcell.Offset(0, -1).Value
            Else
              
              wsMacro.Range("D" & rngcell.Row).Value = rngcell.Offset(0, -1).Value
            End If
          Next rngcell
        End With
    Next i
End Sub

 

[HaHoBe]

Hi satya12,

sorry but I`m lost in what you want. The first code listed the items without any gap in each single column. The second had the items isted on the same row as they were found. The only other option I may think of by mow is to list the items one by one in the two columns. Is that what you want (say first item row 1 in Column C, second Row 2 in Column C, thiird in Row 3 Column D)?

Ciao,
Holger

 

[satya12]

@HaHoBe , sorry for incomplete information, i modified the code in that pasting the value i removed rngcell and add "i" in that place. its working fine.
but problem is when i run this 3 iteration for i = 2 to 4 , for that macro , problem is in sheet where we are finding text having only 2 visible cells , in that output get only 2 rows for C and D columns as per our requirement, in our code its running 3 times .
in my understanding we are change the next i think.

Sub Autofill()
    Windows("HP  Price book.xlsx").Activate
    a = Worksheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row

    For i = 2 To 4
        'PL Number
        Windows("HP INC Price book.xlsx").Activate
        Worksheets("Sheet1").Range("D" & i).Copy
        Windows("Output file.xlsm").Activate
        Worksheets("Macro").Range("A" & i).Select
        ActiveSheet.Paste
        
        'Autofill
        Dim rngcell As Range
        Dim wbHP_Cheat As Workbook
        Dim wsTemp As Worksheet
        Dim wbOutput As Workbook
        Dim wsMacro As Worksheet
       
        Set wbHP_Cheat = Workbooks("Copy of HP  Cheat Sheet.xlsm")
        Set wsTemp = wbHP_Cheat.Sheets("Template")
        Set wbOutput = Workbooks("Output file.xlsm")
        Set wsMacro = wbOutput.Sheets("Macro")
       
        With wsTemp
          For Each rngcell In .Range("G2", .Cells(.Rows.Count, "G").End(xlUp)).SpecialCells(xlCellTypeVisible)
            If InStr(rngcell.Value, "<100") > 0 Then
              wsMacro.Range("C" & i).Value = rngcell.Offset(0, -1).Value
              wsMacro.Range("F" & i).Value = rngcell.Offset(0, 3).Value
              
            Else
              
              wsMacro.Range("D" & i).Value = rngcell.Offset(0, -1).Value
            End If
          Next rngcell
        End With
    Next i
End Sub

 

[HaHoBe]

Hi satya12,

there still is no code for the Autofilter. I would not set constant numbers but rely on the number of visible cells in the data range for the upper number of loops. Does that give you an idea of how to change the code?

Ciao,
Holger