copy-paste to fixed cells macro searchvalue Closed

Question

Hello, 

How are you?
I've been looking for some help in the forums because I'm new to macro programming and have to develop some sort of line codes to copy-paste special values.
The main idea is that I have one column (column H) where I have "copy" values in several rows and blank cells in between. For example: H1 says "copy" and H2...H9 are a blank spaces.
Once I validate which ones I have to copy (the ones with the copy value), I need to copy, paste special for cells I2...I9 the value that appears in cell I1. 
This happens again for cells I11...I20 and it goes on until 1000. 
I hope you can help me.

Below you can find the source code I developed, but I find it is kind of limited since I don't have a great idea of every function:


Dim strsearch As String, lastline As Integer, tocopy As Integer

strsearch = CStr(InputBox("enter the string to search for"))
lastline = Range("H65536").End(xlUp).Row
j = 1

For i = 1 To lastline
    For Each c In Range("H" & i)
        If c.Text = strsearch Then
        'look for the strings that have the copy value, which is input into the InputBox
              tocopy = 1
        End If
    Next c
    If tocopy = 1 Then
        Range("H" & i).Copy
        'the idea here would be to copy-paste the values into the I cells that go from 1 to 10 and for the
        'program to copy this for the next 9 cells because it is always in blocks of 9 that I need the same
        'values to be copied.
        Cells("H" & i + 1).PasteSpecial past:=xlValues
        Application.CutCopyMode = False
        
       
        j = j + 1
    End If
tocopy = 0
Next i



I hope you can help me.
Thanks!

Gastón.


Configuration: Windows 7 / Internet Explorer 9.0

rizvisa1 · Answer

So if I understood you correctly, what you want is that look at column H and find the first "copy" word (lets say it is H1). Then find the next cell in column "H" which is non-BLANk (lets say it is H11).
Once you know the two points, you want to copy the content of I1 (row corresponding to first "Copy" @ H1) cell down to one cell above the next non blank (I10 row corresponding to @H11 -1)

Did i get it correct ?

gastonga · Answer

Exactly!

rizvisa1 · Answer

Try this
I have not tested it so there might be a wrinkle here and there



Sub SearchAndCopy()

   Dim lFirstHit As Long
   Dim lSecondHit As Long
   Dim strsearch As String
   Dim iSearchCol As Integer
   Dim lMaxUsedRows As Long
   
   lMaxUsedRows = getItemLocation("*", Cells)
   iSearchCol = 8 ' column H
   
   Do While True
      strsearch = CStr(InputBox("enter the string to search for"))
      If (strsearch = vbNullString) _
      Then
         Exit Do
      End If
      
   
      lFirstHit = 0
      
      Do While True
         ' FIND WHERE IS MY SEARCH WORD IN ROW
         lFirstHit = getItemLocation(strsearch, Range(Cells(lFirstHit + 1, iSearchCol), Cells(lMaxUsedRows, iSearchCol)), True, False, True)
         If (lFirstHit = 0) Then Exit Do
         
         'FIND WHERE IS THE FIRST NON BLANK SPACE
         lSecondHit = getItemLocation("*", Range(Cells(lFirstHit + 1, iSearchCol), Cells(lMaxUsedRows, iSearchCol)), True, False, True)
         If (lSecondHit = 0) _
         Then
            If (Cells(lFirstHit + 1, iSearchCol) = vbNullString) _
            Then
               lSecondHit = lMaxUsedRows + 1
            End If
         End If
            
         'no non-blank cell found
         If (lSecondHit = 0) Then Exit Do
         
         lSecondHit = lSecondHit - 1
         'next cells is not blank
         If (lSecondHit > lFirstHit) _
         Then
            Cells(lFirstHit, "I").Copy
            Range(Cells(lFirstHit + 1, "I"), Cells(lSecondHit, "I")).PasteSpecial xlPasteValues
         End If
      Loop
   Loop
   
End Sub

Public Function getItemLocation(sLookFor As String, _
                                 rngSearch As Range, _
                                 Optional bFullString As Boolean = True, _
                                 Optional bLastOccurance As Boolean = True, _
                                 Optional bFindRow As Boolean = True) As Long

'find the first/last row/column within a range for a specific string

   Dim Cell As Range
   Dim iLookAt As Integer
   Dim iSearchDir As Integer
   Dim iSearchOdr As Integer
   
   If (bFullString) _
   Then
      iLookAt = xlWhole
   Else
      iLookAt = xlPart
   End If
   If (bLastOccurance) _
   Then
      iSearchDir = xlPrevious
   Else
      iSearchDir = xlNext
   End If
   If Not (bFindRow) _
   Then
      iSearchOdr = xlByColumns
   Else
      iSearchOdr = xlByRows
   End If
   
   With rngSearch
      If (bLastOccurance) _
      Then
         Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir)
      Else
         Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir)
      End If
   End With
   
   If Cell Is Nothing Then
      getItemLocation = 0
   ElseIf Not (bFindRow) _
   Then
      getItemLocation = Cell.Column
   Else
      getItemLocation = Cell.Row
   End If
   Set Cell = Nothing

End Function

Copy-paste to fixed cells macro searchvalue

3 responses

Similar discussions

Subscribe To Our Newsletter!