Sam1015
10-01-2009, 09:54 AM
I just started learning VBA and encountered 2 problems I'm sure would only take someone who actually knows what they're doing a minute.
I have two workseets, I am trying to pull information from the first worksheet and paste it into the desired cells on the second. I need to do this by matching the project numbers in each sheet (i)....here's the first problem, I can't figure out how paste the information in the correct cells.
The entire code so far is the following:
Private Sub CommandButton1_Click()
Dim SearchRange As Range
Dim FoundCells As Range
Dim FoundCell As Range
Dim FindWhat As Variant
Dim MatchCase As Boolean
Dim LookIn As XlFindLookIn
Dim LookAt As XlLookAt
Dim SearchOrder As XlSearchOrder
Dim row As Integer
Dim i As Integer
Dim row_index As Integer
Dim col_index As Integer
row = 9
i = 2
Set SearchRange = ThisWorkbook.Worksheets(1).Range("A1:M175")
FindWhat = Cells(row, i).Value
LookIn = xlValues
LookAt = xlPart
SearchOrder = xlByRows
MatchCase = False
Set FoundCells = FindAll(SearchRange:=SearchRange, FindWhat:=FindWhat, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If FoundCells Is Nothing Then
Debug.Print "No cells found."
Else
For Each FoundCell In FoundCells.Cells
Debug.Print FoundCell.Address, FoundCell.Text
row_index = FoundCell.row
col_index = FoundCell.Column
ThisWorkbook.Worksheets(2).Cells(row, i + 3).Value = ThisWorkbook.Worksheets(1).Cells(row_index, col_index + 2).Value
ThisWorkbook.Worksheets(2).Cells(row, i + 5).Value = ThisWorkbook.Worksheets(1).Cells(row_index, col_index + 3).Value
ThisWorkbook.Worksheets(2).Cells(row, i + 7).Value = ThisWorkbook.Worksheets(1).Cells(row_index, col_index + 4).Value
Next FoundCell
End If
End Sub
Function FindAll(SearchRange As Range, FindWhat As Variant, _
Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional MatchCase As Boolean = False) As Range
Dim FoundCell As Range
Dim FoundCells As Range
Dim LastCell As Range
Dim FirstAddr As String
With SearchRange
Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell = SearchRange.Find(what:=FindWhat, after:=LastCell, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
Set FoundCells = FoundCell
FirstAddr = FoundCell.Address
Do
Set FoundCells = Application.Union(FoundCells, FoundCell)
Set FoundCell = SearchRange.FindNext(after:=FoundCell)
Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr)
End If
If FoundCells Is Nothing Then
Set FindAll = Nothing
Else
Set FindAll = FoundCells
End If
End Function
My problem 1st problem is I need the information data from sheet 1 to past 3 rows below "i" and then over +3, +5, +7 columns on sheet 2. the code for this action is at the end of the Sub Procedure (highlighted in Green)
The second problem is the above code only does this for one project. I need it to do a loop and repeat this action for all the projects.
I hope my explanation was accurate enough as I literally just starting learning vba last week. Any help would be greatly greatly appreciate.
Thanks!!
I have two workseets, I am trying to pull information from the first worksheet and paste it into the desired cells on the second. I need to do this by matching the project numbers in each sheet (i)....here's the first problem, I can't figure out how paste the information in the correct cells.
The entire code so far is the following:
Private Sub CommandButton1_Click()
Dim SearchRange As Range
Dim FoundCells As Range
Dim FoundCell As Range
Dim FindWhat As Variant
Dim MatchCase As Boolean
Dim LookIn As XlFindLookIn
Dim LookAt As XlLookAt
Dim SearchOrder As XlSearchOrder
Dim row As Integer
Dim i As Integer
Dim row_index As Integer
Dim col_index As Integer
row = 9
i = 2
Set SearchRange = ThisWorkbook.Worksheets(1).Range("A1:M175")
FindWhat = Cells(row, i).Value
LookIn = xlValues
LookAt = xlPart
SearchOrder = xlByRows
MatchCase = False
Set FoundCells = FindAll(SearchRange:=SearchRange, FindWhat:=FindWhat, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If FoundCells Is Nothing Then
Debug.Print "No cells found."
Else
For Each FoundCell In FoundCells.Cells
Debug.Print FoundCell.Address, FoundCell.Text
row_index = FoundCell.row
col_index = FoundCell.Column
ThisWorkbook.Worksheets(2).Cells(row, i + 3).Value = ThisWorkbook.Worksheets(1).Cells(row_index, col_index + 2).Value
ThisWorkbook.Worksheets(2).Cells(row, i + 5).Value = ThisWorkbook.Worksheets(1).Cells(row_index, col_index + 3).Value
ThisWorkbook.Worksheets(2).Cells(row, i + 7).Value = ThisWorkbook.Worksheets(1).Cells(row_index, col_index + 4).Value
Next FoundCell
End If
End Sub
Function FindAll(SearchRange As Range, FindWhat As Variant, _
Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional MatchCase As Boolean = False) As Range
Dim FoundCell As Range
Dim FoundCells As Range
Dim LastCell As Range
Dim FirstAddr As String
With SearchRange
Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell = SearchRange.Find(what:=FindWhat, after:=LastCell, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
Set FoundCells = FoundCell
FirstAddr = FoundCell.Address
Do
Set FoundCells = Application.Union(FoundCells, FoundCell)
Set FoundCell = SearchRange.FindNext(after:=FoundCell)
Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr)
End If
If FoundCells Is Nothing Then
Set FindAll = Nothing
Else
Set FindAll = FoundCells
End If
End Function
My problem 1st problem is I need the information data from sheet 1 to past 3 rows below "i" and then over +3, +5, +7 columns on sheet 2. the code for this action is at the end of the Sub Procedure (highlighted in Green)
The second problem is the above code only does this for one project. I need it to do a loop and repeat this action for all the projects.
I hope my explanation was accurate enough as I literally just starting learning vba last week. Any help would be greatly greatly appreciate.
Thanks!!