Hi i am currently trying to edit an extensive questionnaire in excel that is pulled from a bespoke database.
The Answers are ordered by Id Column, Jobno column, Mode, Section, Answer no, Answer code, Answer text.
The issue i am having is that pretty much all of the answers need amending wich can be quite easy but some of them need copying and pasting below up to seven times for one answer and then 7 different answers in putting in the answer code column. i.e
ANSWERID JOBNO MODEL SECTIONNO ANSWERNO ANSWERCODE ANSWERTEXT
8061 57 X 3 60 1 Purple
8062 58 X 4 61 2 Green
8063 59 X 5 62 3 Orange
8064 60 X 6 63 4 Topaz
8065 61 X 7 64 5 Magenta
8066 62 X 8 65 6 Green
This is the basic code i am using to change the cell values based on the SectionNo And AnswerNo>>
' Answer code is "" answer text is "" this should apply blanks to both fields
If Cells(Row, "d") = "3" And Cells(Row, "e") = "3" Then
Cells(Row, "f").Value = ""
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "3" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If
This is the code i am using to duplicate rows and amend an answer in cell for each duplication. The hard bit for me is when the filter is applied i will have a couple of thousand answers for each specific sectionno and answerno and it wont repeat down and complete all of them!
I hope that makes sense.
Sub filtercopy4()
ActiveSheet.Range("$A$1:$E$54").AutoFilter Field:=4, Criteria1:="3"
ActiveSheet.Range("$A$1:$E$54").AutoFilter Field:=5, Criteria1:="9"
Sheets(1).Range("a1").CurrentRegion.SpecialCells(xlCellTypeVisible).Areas(2).Columns(1).Cells(1, 1).Select
'1st line
ActiveCell.EntireRow.Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
ActiveCell.Offset(1, 5).Select
ActiveCell.Value = "01"
ActiveCell.Offset(0, -5).Select
' 2nd line
ActiveCell.EntireRow.Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
ActiveCell.Offset(1, 5).Select
ActiveCell.Value = "02"
ActiveCell.Offset(0, -5).Select
'3rdline
ActiveCell.EntireRow.Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
ActiveCell.Offset(1, 5).Select
ActiveCell.Value = "03"
ActiveCell.Offset(0, -5).Select
End Sub
Any help you can give would be appreciated. Thank you.
The Answers are ordered by Id Column, Jobno column, Mode, Section, Answer no, Answer code, Answer text.
The issue i am having is that pretty much all of the answers need amending wich can be quite easy but some of them need copying and pasting below up to seven times for one answer and then 7 different answers in putting in the answer code column. i.e
ANSWERID JOBNO MODEL SECTIONNO ANSWERNO ANSWERCODE ANSWERTEXT
8061 57 X 3 60 1 Purple
8062 58 X 4 61 2 Green
8063 59 X 5 62 3 Orange
8064 60 X 6 63 4 Topaz
8065 61 X 7 64 5 Magenta
8066 62 X 8 65 6 Green
This is the basic code i am using to change the cell values based on the SectionNo And AnswerNo>>
' Answer code is "" answer text is "" this should apply blanks to both fields
If Cells(Row, "d") = "3" And Cells(Row, "e") = "3" Then
Cells(Row, "f").Value = ""
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "3" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If
This is the code i am using to duplicate rows and amend an answer in cell for each duplication. The hard bit for me is when the filter is applied i will have a couple of thousand answers for each specific sectionno and answerno and it wont repeat down and complete all of them!
I hope that makes sense.
Sub filtercopy4()
ActiveSheet.Range("$A$1:$E$54").AutoFilter Field:=4, Criteria1:="3"
ActiveSheet.Range("$A$1:$E$54").AutoFilter Field:=5, Criteria1:="9"
Sheets(1).Range("a1").CurrentRegion.SpecialCells(xlCellTypeVisible).Areas(2).Columns(1).Cells(1, 1).Select
'1st line
ActiveCell.EntireRow.Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
ActiveCell.Offset(1, 5).Select
ActiveCell.Value = "01"
ActiveCell.Offset(0, -5).Select
' 2nd line
ActiveCell.EntireRow.Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
ActiveCell.Offset(1, 5).Select
ActiveCell.Value = "02"
ActiveCell.Offset(0, -5).Select
'3rdline
ActiveCell.EntireRow.Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
ActiveCell.Offset(1, 5).Select
ActiveCell.Value = "03"
ActiveCell.Offset(0, -5).Select
End Sub
Any help you can give would be appreciated. Thank you.