As per keywords copy data from specific cells in sheet1 and paste to specific columns in sheet2

[Bimmy]

Hello,

This is just an example I'm using.

Currently there are 6 keywords that needs to be updated in different columns. Expecting more keywords in future.

Since it would be time consuming, I thought I would ask assistance for 2 keywords and then do the necessary additions for the remaining.

Looking For -

I have 2 sheets - Sheet1 and Sheet2

The data will be pasted in C2 in sheet1 which will also contain specific keywords.

Depending on keywords the macro should copy data from specific cells in sheet1 and paste them to specific columns in sheet2. This should happen on the click of a button.

If keyword is abc then macro should copy and paste data as mentioned in the attachment.
If keyword is def then macro should copy and paste data as mentioned in the attachment.

Optional Requirement -

On Sheet 2 -

Depending on multiple entries in Column H on sheet2, macro should duplicate the data in corresponding blank columns. Refer attachment for clarity.

Very Important -

As stated at the start, options should be provided in the code (a remark would be helpful) to add additional keywords, cells and columns

Any assistance will be greatly appreciated.

 

[p45cal]

Some questions:
1. Which column of sheet2 will be GUARANTEED to always have data in? (Column H? Column M?).This so as to know whch row to add new data to.

2. Currently, in Sheet1, names start at row 8 and the additional name is 3 rows down at row 11. If there are more names, is this pattern continued? (ie. do I continue to look for data in column C in rows 14, 17, 20 etc. until a blank is encountered there?)

2. If there aren't any additional names at all (apart from the first one) will cell C11 be blank?

3. Will cell C8 ALWAYS be populated?

 

[Bimmy]

Answers

1) Sheet2 will always be blank, if my explanation is correct, after the macro is run, Column H and M will have multiple data in them. This would be Name1, Name2 and so on in Column H and values 123, 456 and so on in Column M .

2) Total 9 names will be there, that is the data will end in row 32 (Not always). Your suggestion to look for data in column C until a blank is encountered is an option that sounds great.

3) Cell C8 will not be always populated.

 

[p45cal]

Test:

Sub blah()
With Sheets("Sheet2")
  DestnRow = .Cells(.Rows.Count, "H").End(xlUp).Row + 1
End With
With Sheets("Sheet1")
  Select Case .Range("C4")  'the keyword.
    Case "abc"
      myArray = Array("A", "C", "F", "L", "J")  'these are destination columns
    Case "def", "ghi", "xyz"  'this includes any other keywords that share the same destination column  pattern.
      myArray = Array("A", "D", "F", "K", "I")  'these are destination columns
'    Case Else
'      myArray = Array("P", "Q", "R", "s", "T")  'default destination columns for any other keyword not in above Cases.
  End Select
  For i = 2 To 6  'the rows on sheet1 (column C) where data is always pasted.
    Sheets("Sheet2").Cells(DestnRow, myArray(i - 2)).Value = .Cells(i, "C").Value
  Next i
  Set Sce = .Cells(8, "C")  'first name location
  If Sce.Value <> "" Then
    Do
      Sce.Select
      Sheets("Sheet2").Cells(DestnRow, "H").Value = Sce.Value
      Sheets("Sheet2").Cells(DestnRow, "M").Value = Sce.Offset(1).Value  'cell below the name
      Set Sce = Sce.Offset(3)  '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

 

[p45cal]

there's one line you should take out, it's:
Sce.Select

 

[Bimmy]

p45cal... First of all many thanks for your code.

I have tweaked the code and out of the 6 keywords, I was able to get the code partly correct for 5 of them. Need 1 adjustment which is -

In the attached example, the data is pasted from C2 to C6 and the code copies all the data from C2 to C6 and paste them to specified columns in sheet2.

Can the code copy data from specific cells and paste them to specified columns.

Example -

If the keyword is abc then macro should -
Copy data from C2 and paste to Column A
Copy data from C4 and paste to Column F
Copy data from C6 and paste to Column J... and so on

If the keyword is def then macro should -
Copy data from C3 and paste to Column C
Copy data from C5 and paste to Column L
Copy data from C6 and paste to Column J... and so on

For the 6th keyword xyz, the data will be pasted from C2 to C10. Name will start at row 12.

Macro should -

If the keyword is xyz then macro should -
Copy data from C2 and paste to Column A
Copy data from C3 and paste to Column P
Copy data from C5 and paste to Column L
Copy data from C7 and paste to Column K
Copy data from C8 and paste to Column N
Copy data from C10 and paste to Column O... and so on

In short, for keywords abc, def name starts at row 8 and for xyz name starts at row 10.

Based on above explanation can a combined macro be created.

Remarks in the code will be helpful for future additions.

 

[p45cal]

In the attached example, the data is…

Is there an attachment, or is it just the text? An attachment would be better.

 

[Bimmy]

In the attached sheet I have examples of keywords in Grey colour one below the other. When creating code, paste the examples in C2 and do the needful.

Correction on below statement

In short, for keywords abc, def name starts at row 8 and for xyz name starts at row 10.

It should be (last part)

In short, for keywords abc, def name starts at row 8 and for xyz name starts at row 12.

 

[p45cal]

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, "H").End(xlUp).Row + 1  'uses column H on destination sheet to determin which is the next clear row to put data into.
End With
FirstNameRow = 8  'most keywords' first names start in row 8.
With Sheets("Sheet1")  'ActiveSheet ''Activesheet, specific sheet, whichever.
  Select Case .Range("C4")  'the keyword.
    Case "abc"
      ToColms = Array("A", "F", "J")  'these are destination columns
      FromRows = Array(2, 4, 6)
    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("A", "P", "L", "K", "N", "O")  'these are destination columns
      FromRows = Array(2, 4, 5, 7, 8, 10)
      FirstNameRow = 12
      '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, "H").Value = Sce.Value
      DestnSheet.Cells(DestnRow, "M").Value = Sce.Offset(1).Value  'cell below the name
      Set Sce = Sce.Offset(3)  '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

 

[Bimmy]

Much appreciated.
Code works perfectly....