Silver
06-26-2016, 01:50 AM
Hello,
I have a code that looks for certain keywords and copies data from specific cells in col c on sheet1 and paste them into specific cols in sheet2.
Below is an example of how the request looks from which the data is pasted
16475
Below is an example of how the data gets pasted once the macro is run
16477
Another example of the data, but last 3 data is for more than 1 staff
16476
Below is an example of how the data gets pasted once the macro is run
16479
As you can see, last 3 data are pasted correctly (3 times) in their respective columns. But remaining datas are pasted once.
Below is the code that I'm using
Sub blah()
Set DestnSheet = Sheets("Sheet2") 'just so that this line is the only line to change if you want to change the destination sheet.
With DestnSheet
DestnRow = .Cells(.Rows.Count, "J").End(xlUp).Row + 1 'uses column J on destination sheet to determin which is the next clear row to put data into.
End With
FirstNameRow = 15 'most keywords' first names start in row 8.
With Sheets("Sheet1") 'ActiveSheet ''Activesheet, specific sheet, whichever.
Select Case .Range("C8") 'the keyword.
Case "ABC"
ToColms = Array("D", "N", "O", "G", "I", "E") 'these are destination columns
FromRows = Array(2, 5, 8, 11, 12, 15)
Case "def", "ghi", "zzz" 'this includes any other keywords that share the same destination column pattern.
ToColms = Array("C", "L", "J") 'these are destination columns
FromRows = Array(3, 5, 6)
Case "XYZ"
ToColms = Array("D", "N", "O", "G", "I", "Q", "R") 'these are destination columns
FromRows = Array(2, 5, 8, 11, 12, 13, 14)
FirstNameRow = 18
'Case Else
'ToColms = Array("P", "Q", "R", "S", "T") 'default destination columns for any other keyword not in above Cases.
'FromRows = Array(99, 98, 97, 96, 95)
End Select
i = LBound(ToColms) 'the rows on sheet1 (column C) where data is always pasted.
For Each rw In FromRows
DestnSheet.Cells(DestnRow, ToColms(i)).Value = .Cells(rw, "C").Value
i = i + 1
Next rw
Set Sce = .Cells(FirstNameRow, "C") 'first name location
If Sce.Value <> "" Then
Do
DestnSheet.Cells(DestnRow, "E").Value = Sce.Value
DestnSheet.Cells(DestnRow, "J").Value = Sce.Offset(1).Value 'cell below the name
DestnSheet.Cells(DestnRow, "X").Value = Sce.Offset(2).Value 'cell below the name
Set Sce = Sce.Offset(4) 'next additional name is 3 cells down
DestnRow = DestnRow + 1 'next ow down on destination sheet (sheet2)
Loop Until Sce.Value = ""
End If
End With
End Sub
Addition Required -
The code should paste data in their respective columns depending on last 3 data :
Example :
a) If last 3 data is for 1 staff, macro should paste data once in the respective columns
b) If last 3 data is for 2 staff, macro should paste data twice in the respective columns... so on
Any assistance will be highly appreciated.
Have attached sample sheet.
I have a code that looks for certain keywords and copies data from specific cells in col c on sheet1 and paste them into specific cols in sheet2.
Below is an example of how the request looks from which the data is pasted
16475
Below is an example of how the data gets pasted once the macro is run
16477
Another example of the data, but last 3 data is for more than 1 staff
16476
Below is an example of how the data gets pasted once the macro is run
16479
As you can see, last 3 data are pasted correctly (3 times) in their respective columns. But remaining datas are pasted once.
Below is the code that I'm using
Sub blah()
Set DestnSheet = Sheets("Sheet2") 'just so that this line is the only line to change if you want to change the destination sheet.
With DestnSheet
DestnRow = .Cells(.Rows.Count, "J").End(xlUp).Row + 1 'uses column J on destination sheet to determin which is the next clear row to put data into.
End With
FirstNameRow = 15 'most keywords' first names start in row 8.
With Sheets("Sheet1") 'ActiveSheet ''Activesheet, specific sheet, whichever.
Select Case .Range("C8") 'the keyword.
Case "ABC"
ToColms = Array("D", "N", "O", "G", "I", "E") 'these are destination columns
FromRows = Array(2, 5, 8, 11, 12, 15)
Case "def", "ghi", "zzz" 'this includes any other keywords that share the same destination column pattern.
ToColms = Array("C", "L", "J") 'these are destination columns
FromRows = Array(3, 5, 6)
Case "XYZ"
ToColms = Array("D", "N", "O", "G", "I", "Q", "R") 'these are destination columns
FromRows = Array(2, 5, 8, 11, 12, 13, 14)
FirstNameRow = 18
'Case Else
'ToColms = Array("P", "Q", "R", "S", "T") 'default destination columns for any other keyword not in above Cases.
'FromRows = Array(99, 98, 97, 96, 95)
End Select
i = LBound(ToColms) 'the rows on sheet1 (column C) where data is always pasted.
For Each rw In FromRows
DestnSheet.Cells(DestnRow, ToColms(i)).Value = .Cells(rw, "C").Value
i = i + 1
Next rw
Set Sce = .Cells(FirstNameRow, "C") 'first name location
If Sce.Value <> "" Then
Do
DestnSheet.Cells(DestnRow, "E").Value = Sce.Value
DestnSheet.Cells(DestnRow, "J").Value = Sce.Offset(1).Value 'cell below the name
DestnSheet.Cells(DestnRow, "X").Value = Sce.Offset(2).Value 'cell below the name
Set Sce = Sce.Offset(4) 'next additional name is 3 cells down
DestnRow = DestnRow + 1 'next ow down on destination sheet (sheet2)
Loop Until Sce.Value = ""
End If
End With
End Sub
Addition Required -
The code should paste data in their respective columns depending on last 3 data :
Example :
a) If last 3 data is for 1 staff, macro should paste data once in the respective columns
b) If last 3 data is for 2 staff, macro should paste data twice in the respective columns... so on
Any assistance will be highly appreciated.
Have attached sample sheet.